1. Instalación de paquetes y Carga de Librerías

#install.packages("easypackages")

library("easypackages")      # instalamos y cargamos los paquetes
paq <- c("car", "ggplot2", "ggcorrplot", "dplyr", "readxl", "FactoMineR", 
         "corrplot", "GGally", "factoextra", "Hmisc", "PerformanceAnalytics", "dummy")
packages(paq)
## Loading required package: car
## Loading required package: carData
## Loading required package: ggplot2
## Loading required package: ggcorrplot
## Loading required package: dplyr
## 
## Attaching package: 'dplyr'
## The following object is masked from 'package:car':
## 
##     recode
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Loading required package: readxl
## Loading required package: FactoMineR
## Loading required package: corrplot
## corrplot 0.92 loaded
## Loading required package: GGally
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## Loading required package: factoextra
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
## Loading required package: Hmisc
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Attaching package: 'xts'
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
## 
##     legend
## Loading required package: dummy
## dummy 0.1.3
## dummyNews()
## All packages loaded successfully
set.seed(567)

2. Data

Importamos y verificamos la data:

getwd()
## [1] "/Users/davidxaviercardenasgiler12promax/Library/CloudStorage/OneDrive-Personal/LENGUAJES PROGRAMACIÓN/RSTUDIO/CURSO DATA & ANALYTICS/PROYECTOS/PROYECTO 02/PROYETO_FINAL"
data_nutricion <- read_excel("Caso. Data_Nutricion (1).xlsx")
str(data_nutricion)
## tibble [652 × 23] (S3: tbl_df/tbl/data.frame)
##  $ N°                         : num [1:652] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Individuo                  : chr [1:652] "Persona 1" "Persona 2" "Persona 3" "Persona 4" ...
##  $ sexo                       : chr [1:652] "F" "F" "F" "F" ...
##  $ talla                      : num [1:652] 156 166 151 152 160 ...
##  $ edad                       : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : chr [1:652] "71.2" "61" "49.1" "54.6" ...
##  $ circun_cuello              : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num [1:652] 90 80.9 72 74.4 79.6 ...
##  $ cadera                     : chr [1:652] "98" "100.5" "86" "88.4" ...
##  $ ind_cintura_cadera         : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : chr [1:652] "13" "5" "13" "5" ...
##  $ pliegue_cutaneo_TRICEPS    : chr [1:652] "27" "19" "18" "19" ...
##  $ pliegue_cutaneo_ESCAPULAR  : chr [1:652] "32" "15" "18" "15" ...
##  $ pliegue_cutaneo_SUPRAILIACO: chr [1:652] "34" "22" "17" "18" ...
##  $ clasif_diagnos_talla_edad  : chr [1:652] "RIESGO DE TALLA BAJA" "TALLA NORMAL" "RIESGO DE TALLA BAJA" "RIESGO DE TALLA BAJA" ...
##  $ clasif_diagnos_IMC         : chr [1:652] "OBESIDAD" "NORMAL" "NORMAL" "NORMAL" ...
##  $ clasif_perimetro_abdominal : chr [1:652] "ALTO RIESGO" "BAJO RIESGO" "BAJO RIESGO" "BAJO RIESGO" ...
##  $ clasif_anemia              : chr [1:652] "NO PRESENTA ANEMIA" "NO PRESENTA ANEMIA" "ANEMIA LEVE" "NO PRESENTA ANEMIA" ...
##  $ target                     : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...

** Nota: 652 Observaciones y 23 variables cargadas.

Seleccionamos solo la data que vamos a utilizar en el PCA:

dnutricion <- data_nutricion
dnutricion <- dnutricion[,c(-1:-2)]  
str(dnutricion)
## tibble [652 × 21] (S3: tbl_df/tbl/data.frame)
##  $ sexo                       : chr [1:652] "F" "F" "F" "F" ...
##  $ talla                      : num [1:652] 156 166 151 152 160 ...
##  $ edad                       : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : chr [1:652] "71.2" "61" "49.1" "54.6" ...
##  $ circun_cuello              : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num [1:652] 90 80.9 72 74.4 79.6 ...
##  $ cadera                     : chr [1:652] "98" "100.5" "86" "88.4" ...
##  $ ind_cintura_cadera         : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : chr [1:652] "13" "5" "13" "5" ...
##  $ pliegue_cutaneo_TRICEPS    : chr [1:652] "27" "19" "18" "19" ...
##  $ pliegue_cutaneo_ESCAPULAR  : chr [1:652] "32" "15" "18" "15" ...
##  $ pliegue_cutaneo_SUPRAILIACO: chr [1:652] "34" "22" "17" "18" ...
##  $ clasif_diagnos_talla_edad  : chr [1:652] "RIESGO DE TALLA BAJA" "TALLA NORMAL" "RIESGO DE TALLA BAJA" "RIESGO DE TALLA BAJA" ...
##  $ clasif_diagnos_IMC         : chr [1:652] "OBESIDAD" "NORMAL" "NORMAL" "NORMAL" ...
##  $ clasif_perimetro_abdominal : chr [1:652] "ALTO RIESGO" "BAJO RIESGO" "BAJO RIESGO" "BAJO RIESGO" ...
##  $ clasif_anemia              : chr [1:652] "NO PRESENTA ANEMIA" "NO PRESENTA ANEMIA" "ANEMIA LEVE" "NO PRESENTA ANEMIA" ...
##  $ target                     : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...

Conversión de variables cualitativas a factor y caracter a numércias

dnutricion$sexo <- as.factor(dnutricion$sexo) 
dnutricion$talla <- as.numeric(dnutricion$talla)
dnutricion$clasif_anemia <- as.factor(dnutricion$clasif_anemia)
dnutricion$clasif_diagnos_talla_edad <- as.factor(dnutricion$clasif_diagnos_talla_edad)
dnutricion$clasif_diagnos_IMC <- as.factor(dnutricion$clasif_diagnos_IMC)
dnutricion$clasif_perimetro_abdominal<- as.factor(dnutricion$clasif_perimetro_abdominal)

dnutricion$cadera <- as.numeric(dnutricion$cadera)
dnutricion$pliegue_cutaneo_BICEPS<- as.numeric(dnutricion$pliegue_cutaneo_BICEPS)
dnutricion$pliegue_cutaneo_TRICEPS<- as.numeric(dnutricion$pliegue_cutaneo_TRICEPS)
dnutricion$pliegue_cutaneo_ESCAPULAR<- as.numeric(dnutricion$pliegue_cutaneo_ESCAPULAR)
dnutricion$pliegue_cutaneo_SUPRAILIACO<- as.numeric(dnutricion$pliegue_cutaneo_SUPRAILIACO)
dnutricion$peso_kg <- as.numeric(dnutricion$peso_kg)
str(dnutricion)
## tibble [652 × 21] (S3: tbl_df/tbl/data.frame)
##  $ sexo                       : Factor w/ 2 levels "F","M": 1 1 1 1 1 1 2 2 1 2 ...
##  $ talla                      : num [1:652] 156 166 151 152 160 ...
##  $ edad                       : num [1:652] 16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num [1:652] 71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num [1:652] 35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num [1:652] 29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num [1:652] 90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num [1:652] 98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num [1:652] 0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num [1:652] 0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num [1:652] 36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num [1:652] 45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num [1:652] 13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num [1:652] 27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num [1:652] 32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num [1:652] 34 22 17 18 19 20 6 11.5 NA 9 ...
##  $ clasif_diagnos_talla_edad  : Factor w/ 4 levels "RIESGO DE TALLA BAJA",..: 1 4 1 1 4 4 1 1 4 4 ...
##  $ clasif_diagnos_IMC         : Factor w/ 5 levels "DELGADEZ","NORMAL",..: 3 2 2 2 2 5 4 2 3 4 ...
##  $ clasif_perimetro_abdominal : Factor w/ 2 levels "ALTO RIESGO",..: 1 2 2 2 2 1 2 2 1 2 ...
##  $ clasif_anemia              : Factor w/ 4 levels "ANEMIA LEVE",..: 3 3 1 3 3 NA 3 3 3 3 ...
##  $ target                     : num [1:652] 1 0 0 0 1 0 1 0 1 0 ...
# Datos perdidos en el DataFrame
which(is.na(dnutricion))  # filas que tienen datos perdidos
##   [1]    14    15    27    28    29    30    31    32   108   109   110   267
##  [13]   268   269   270   413   455   482   483   484   543   574   575   576
##  [25]   577   689   690   691   692   742   743   744   902   903   904   971
##  [37]   972  1010  1011  1160  1190  1193  1715  1818  2219  2220  2221  2466
##  [49]  2563  2886  2887  2928  2929  3023  3062  3127  3873  3977  4192  4193
##  [61]  4256  4257  4258  4259  4260  4261  4270  4452  4983  5078  5230  5281
##  [73]  5295  5469  5470  5471  5472  5473  5571  5624  5668  5875  6214  6230
##  [85]  6481  6543  6879  6939  7185  7385  7440  7441  7442  7443  7444  7489
##  [97]  7490  7491  7492  7493  7494  7517  7897  7951  8170  8360  8428  8490
## [109]  8497  8813  8819  8833  8898  8987  9071  9200  9416  9482  9545  9637
## [121]  9684  9789  9913 10561 10643 10702 10793 11020 11037 11102 11150 11350
## [133] 11545 11546 11547 11548 11549 11550 11551 11552 11634 11700 11808 11858
## [145] 11950 11994 12324 12394 12452 12458 12461 12646 13006 13037 13038

Determinamos el total de datos perdidos

sum(is.na(dnutricion))
## [1] 155

Número de datos perdidos por cada variable

apply(is.na(dnutricion), 2, sum)
##                        sexo                       talla 
##                          25                          17 
##                        edad                     peso_kg 
##                           2                           5 
##               circun_cuello                         IMC 
##                           7                           1 
##              circun_cintura                      cadera 
##                          11                           2 
##          ind_cintura_cadera        ind_cintura_estatura 
##                          11                           4 
##          por_grasa_corporal      masa_corporal_magra_kg 
##                           3                          14 
##      pliegue_cutaneo_BICEPS     pliegue_cutaneo_TRICEPS 
##                           5                           8 
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO 
##                           6                           2 
##   clasif_diagnos_talla_edad          clasif_diagnos_IMC 
##                           6                          13 
##  clasif_perimetro_abdominal               clasif_anemia 
##                           5                           8 
##                      target 
##                           0

Vista porcentual de datos perdidos por variable

apply(is.na(dnutricion), 2, mean) # % de datos perdidos por variable
##                        sexo                       talla 
##                 0.038343558                 0.026073620 
##                        edad                     peso_kg 
##                 0.003067485                 0.007668712 
##               circun_cuello                         IMC 
##                 0.010736196                 0.001533742 
##              circun_cintura                      cadera 
##                 0.016871166                 0.003067485 
##          ind_cintura_cadera        ind_cintura_estatura 
##                 0.016871166                 0.006134969 
##          por_grasa_corporal      masa_corporal_magra_kg 
##                 0.004601227                 0.021472393 
##      pliegue_cutaneo_BICEPS     pliegue_cutaneo_TRICEPS 
##                 0.007668712                 0.012269939 
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO 
##                 0.009202454                 0.003067485 
##   clasif_diagnos_talla_edad          clasif_diagnos_IMC 
##                 0.009202454                 0.019938650 
##  clasif_perimetro_abdominal               clasif_anemia 
##                 0.007668712                 0.012269939 
##                      target 
##                 0.000000000

Imputamos: Imputación Paramétrica

#dnutricion_imp <- impute(dnutricion, classes = list(
#                                     factor  = imputeMode(), 
#                                    integer  = imputeMedian(),
#                                    numeric  = imputeMedian()),
#              dummy.classes = c("integer","factor"), dummy.type = "numeric")
#dnutricion_imp = dnutricion_imp$data[,1:min(dim(dnutricion))]

Cargo dnutricion.Rds

dnutricion <- readRDS("dnutricion.rds")    #levantamos
dnutricion_imp <- dnutricion

Nos aseguramos que el nuevo dataframe no hay datos NaN

sum(is.na(dnutricion_imp))    #total datos perdidos
## [1] 0
sapply(dnutricion_imp, function(x) sum(is.na(x)))
##                        sexo                       talla 
##                           0                           0 
##                        edad                     peso_kg 
##                           0                           0 
##               circun_cuello                         IMC 
##                           0                           0 
##              circun_cintura                      cadera 
##                           0                           0 
##          ind_cintura_cadera        ind_cintura_estatura 
##                           0                           0 
##          por_grasa_corporal      masa_corporal_magra_kg 
##                           0                           0 
##      pliegue_cutaneo_BICEPS     pliegue_cutaneo_TRICEPS 
##                           0                           0 
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO 
##                           0                           0 
##   clasif_diagnos_talla_edad          clasif_diagnos_IMC 
##                           0                           0 
##  clasif_perimetro_abdominal               clasif_anemia 
##                           0                           0 
##                      target 
##                           0
dnutricion <- dnutricion_imp

saveRDS(dnutricion, file="dnutricion.rds")  # guardamos

#dnutricion <- readRDS("dnutricon.rds")    #levantamos

str(dnutricion)
## 'data.frame':    652 obs. of  21 variables:
##  $ sexo                       : Factor w/ 2 levels "F","M": 1 1 1 1 1 1 2 2 1 2 ...
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ clasif_diagnos_talla_edad  : Factor w/ 4 levels "RIESGO DE TALLA BAJA",..: 1 4 1 1 4 4 1 1 4 4 ...
##  $ clasif_diagnos_IMC         : Factor w/ 5 levels "DELGADEZ","NORMAL",..: 3 2 2 2 2 5 4 2 3 4 ...
##  $ clasif_perimetro_abdominal : Factor w/ 2 levels "ALTO RIESGO",..: 1 2 2 2 2 1 2 2 1 2 ...
##  $ clasif_anemia              : Factor w/ 4 levels "ANEMIA LEVE",..: 3 3 1 3 3 3 3 3 3 3 ...
##  $ target                     : num  1 0 0 0 1 0 1 0 1 0 ...

Convirtiendo variables cualitativas en Dummy

#Variables_dummy <- dummy(df1[, 1]) # index
variables_dummy <- dummy(dnutricion [, c(1, 17, 18, 19,20)]) # index

Convierto variables dummy a numéricas

#df1$Variables_dummy<-dummy(df1 [, c(1, 17, 18, 19,20)])
variables_dummy<- variables_dummy %>%
  mutate_all(as.numeric)
str(variables_dummy)
## 'data.frame':    652 obs. of  17 variables:
##  $ sexo_F                                        : num  1 1 1 1 1 1 0 0 1 0 ...
##  $ sexo_M                                        : num  0 0 0 0 0 0 1 1 0 1 ...
##  $ clasif_diagnos_talla_edad_RIESGO.DE.TALLA.BAJA: num  1 0 1 1 0 0 1 1 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.BAJA          : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.BAJA.SEVERA   : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.NORMAL        : num  0 1 0 0 1 1 0 0 1 1 ...
##  $ clasif_diagnos_IMC_DELGADEZ                   : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_IMC_NORMAL                     : num  0 1 1 1 1 0 0 1 0 0 ...
##  $ clasif_diagnos_IMC_OBESIDAD                   : num  1 0 0 0 0 0 0 0 1 0 ...
##  $ clasif_diagnos_IMC_RIESGO.DE.BAJO.PESO        : num  0 0 0 0 0 0 1 0 0 1 ...
##  $ clasif_diagnos_IMC_SOBREPESO                  : num  0 0 0 0 0 1 0 0 0 0 ...
##  $ clasif_perimetro_abdominal_ALTO.RIESGO        : num  1 0 0 0 0 1 0 0 1 0 ...
##  $ clasif_perimetro_abdominal_BAJO.RIESGO        : num  0 1 1 1 1 0 1 1 0 1 ...
##  $ clasif_anemia_ANEMIA.LEVE                     : num  0 0 1 0 0 0 0 0 0 0 ...
##  $ clasif_anemia_ANEMIA.MODERADA                 : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_anemia_NO.PRESENTA.ANEMIA              : num  1 1 0 1 1 1 1 1 1 1 ...
##  $ clasif_anemia_VALORES.INCORRECTOS             : num  0 0 0 0 0 0 0 0 0 0 ...

Trabajo solo con variables numéricas

dx1<-dnutricion[, c(-1, -17, -18, -19, -20)]
str(dx1)
## 'data.frame':    652 obs. of  16 variables:
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                     : num  1 0 0 0 1 0 1 0 1 0 ...

Creamos un dataframe uniendo los dataframe creados El propósito es tener solo variables cuantitativas

dfnum<- bind_cols(dx1, variables_dummy)
str(dfnum)
## 'data.frame':    652 obs. of  33 variables:
##  $ talla                                         : num  156 166 151 152 160 ...
##  $ edad                                          : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                                       : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello                                 : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                                           : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura                                : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                                        : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera                            : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura                          : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal                            : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg                        : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS                        : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS                       : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR                     : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO                   : num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                                        : num  1 0 0 0 1 0 1 0 1 0 ...
##  $ sexo_F                                        : num  1 1 1 1 1 1 0 0 1 0 ...
##  $ sexo_M                                        : num  0 0 0 0 0 0 1 1 0 1 ...
##  $ clasif_diagnos_talla_edad_RIESGO.DE.TALLA.BAJA: num  1 0 1 1 0 0 1 1 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.BAJA          : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.BAJA.SEVERA   : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_talla_edad_TALLA.NORMAL        : num  0 1 0 0 1 1 0 0 1 1 ...
##  $ clasif_diagnos_IMC_DELGADEZ                   : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_diagnos_IMC_NORMAL                     : num  0 1 1 1 1 0 0 1 0 0 ...
##  $ clasif_diagnos_IMC_OBESIDAD                   : num  1 0 0 0 0 0 0 0 1 0 ...
##  $ clasif_diagnos_IMC_RIESGO.DE.BAJO.PESO        : num  0 0 0 0 0 0 1 0 0 1 ...
##  $ clasif_diagnos_IMC_SOBREPESO                  : num  0 0 0 0 0 1 0 0 0 0 ...
##  $ clasif_perimetro_abdominal_ALTO.RIESGO        : num  1 0 0 0 0 1 0 0 1 0 ...
##  $ clasif_perimetro_abdominal_BAJO.RIESGO        : num  0 1 1 1 1 0 1 1 0 1 ...
##  $ clasif_anemia_ANEMIA.LEVE                     : num  0 0 1 0 0 0 0 0 0 0 ...
##  $ clasif_anemia_ANEMIA.MODERADA                 : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ clasif_anemia_NO.PRESENTA.ANEMIA              : num  1 1 0 1 1 1 1 1 1 1 ...
##  $ clasif_anemia_VALORES.INCORRECTOS             : num  0 0 0 0 0 0 0 0 0 0 ...

Análisis Descriptivo

Coeficiente de variación

creamos una función

coeficiente.variacion<-function(x){ 
  
  m = mean(x)
  s = sd(x)
  return ( round(s/m * 100,2))
}

Coeficiente de variación de todas las columnas cuantitativas

apply(dx1, 2, FUN=coeficiente.variacion)  # 1ra opción
##                       talla                        edad 
##                        4.57                        7.12 
##                     peso_kg               circun_cuello 
##                       14.88                        6.69 
##                         IMC              circun_cintura 
##                       13.53                        9.31 
##                      cadera          ind_cintura_cadera 
##                        8.02                        6.52 
##        ind_cintura_estatura          por_grasa_corporal 
##                        9.77                       33.47 
##      masa_corporal_magra_kg      pliegue_cutaneo_BICEPS 
##                       15.74                       61.34 
##     pliegue_cutaneo_TRICEPS   pliegue_cutaneo_ESCAPULAR 
##                       36.18                       36.70 
## pliegue_cutaneo_SUPRAILIACO                      target 
##                       40.53                      208.59
mapply(coeficiente.variacion, dx1)       # 2da opción
##                       talla                        edad 
##                        4.57                        7.12 
##                     peso_kg               circun_cuello 
##                       14.88                        6.69 
##                         IMC              circun_cintura 
##                       13.53                        9.31 
##                      cadera          ind_cintura_cadera 
##                        8.02                        6.52 
##        ind_cintura_estatura          por_grasa_corporal 
##                        9.77                       33.47 
##      masa_corporal_magra_kg      pliegue_cutaneo_BICEPS 
##                       15.74                       61.34 
##     pliegue_cutaneo_TRICEPS   pliegue_cutaneo_ESCAPULAR 
##                       36.18                       36.70 
## pliegue_cutaneo_SUPRAILIACO                      target 
##                       40.53                      208.59

Coeficiente de variación de una variable cuantitativa

round(coeficiente.variacion(dnutricion$IMC), 2)  
## [1] 13.53

Gráfico Histograma de todas las variables

library(corrplot)
library(gplots)
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:PerformanceAnalytics':
## 
##     textplot
## The following object is masked from 'package:stats':
## 
##     lowess
library(ggplot2)
library(ggplot2)
library(dplyr)
library(readr)
library(corrplot)
library(readxl)
library(gplots)
library(ParamHelpers)
library(mlr)
## Warning message: 'mlr' is in 'maintenance-only' mode since July 2019.
## Future development will only happen in 'mlr3'
## (<https://mlr3.mlr-org.com>). Due to the focus on 'mlr3' there might be
## uncaught bugs meanwhile in {mlr} - please consider switching.
## 
## Attaching package: 'mlr'
## The following object is masked from 'package:Hmisc':
## 
##     impute
library(car)
library(VIM)
## Loading required package: colorspace
## Loading required package: grid
## VIM is ready to use.
## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
## 
## Attaching package: 'VIM'
## The following object is masked from 'package:datasets':
## 
##     sleep
library(dplyr)
library(stats)
library(dummy)
library(skimr)
library(DataExplorer)
plot_histogram(dnutricion)

par(mfrow = c(1, 2))

hist(dnutricion$IMC, probability = TRUE, xlab = "IMC", 
     col = "grey",
     axes = FALSE, 
     main = "Histograma de IMC")
axis(1)
lines(density(dnutricion$IMC), col = "red", lwd = 2)

#par(new = TRUE)
boxplot(dnutricion$IMC ~ dnutricion$target, data = dnutricion, col = 3:5,
        main="Boxplot del IMC",
        xlab="target",
        ylab="IMC"
        ) 

Análisis Cualitativo de : clasif_diagnos_IMC

summary(dnutricion$clasif_diagnos_IMC)
##            DELGADEZ              NORMAL            OBESIDAD RIESGO DE BAJO PESO 
##                   1                 431                  30                  17 
##           SOBREPESO 
##                 173

Análisis Cualitativo de : clasif_perimetro abdominal

summary(dnutricion$clasif_perimetro_abdominal)
## ALTO RIESGO BAJO RIESGO 
##         121         531
# Graficamos las 2 variables cualitativas

Tabla1=table(dnutricion$clasif_diagnos_IMC)
Tabla2=table(dnutricion$clasif_perimetro_abdominal)

par(mfrow=c(1,2)) # 1 fila 2 columnas
balloonplot(t(Tabla1), main ="Gráfico No. 1",xlab ="Clasificación IMC", label = FALSE, show.margins = FALSE)
balloonplot(t(Tabla2), main ="Gráfico No. 2",xlab ="Perímetro Abdominal", label = FALSE, show.margins = FALSE)

VER LA NORMALIDAD DE LOS DATOS.

Planteamiento de Hipótesis

Ho: Los datos si están normalmente distribuidos
Ha: Los datos no están normalmente distribuidos

Nivel de significancia = 5% (0.05)

#————————————————-

1.b) Aplicamos la prueba de normalidad

# IMC
qqnorm(dnutricion$IMC)
qqline(dnutricion$IMC)

# Test: Kolmogorov-Smirnov "para la prueba de normalidad, n>50 casos"
library(nortest) 
lillie.test(dnutricion$IMC)$p.value
## [1] 4.109185e-08

Decisión: Los datos de la variables “IMC” no están normalmente distribuidos; esto afirmamos con un nivel de confianza del 95% / nivel de significancia del 5%.

# Perímetro Abdominal
qqnorm(dnutricion$por_grasa_corporal)
qqline(dnutricion$por_grasa_corporal)

# Test: Kolmogorov-Smirnov "para la prueba de normalidad, n>50 casos"
library(nortest) 
lillie.test(dnutricion$por_grasa_corporal)$p.value
## [1] 8.77055e-34

Decisión: Los datos de la variables “grasa corporal” no están normalmente distribuidos; esto afirmamos con un nivel de confianza del 95% / nivel de significancia del 5%.

Análisis de Componentes Principales PCA

Observando la media y la varaianza de las variables:

apply(X = dx1, MARGIN = 2, FUN = mean)
##                       talla                        edad 
##                 158.7503067                  14.7638037 
##                     peso_kg               circun_cuello 
##                  56.9662577                  32.1602761 
##                         IMC              circun_cintura 
##                  22.4239663                  74.6368098 
##                      cadera          ind_cintura_cadera 
##                  89.8757669                   0.8309885 
##        ind_cintura_estatura          por_grasa_corporal 
##                   0.4708023                  23.5141083 
##      masa_corporal_magra_kg      pliegue_cutaneo_BICEPS 
##                  43.3446643                   9.1786810 
##     pliegue_cutaneo_TRICEPS   pliegue_cutaneo_ESCAPULAR 
##                  15.6702454                  14.3911043 
## pliegue_cutaneo_SUPRAILIACO                      target 
##                  14.6595092                   0.1871166

Observando la varianza de las variables:

apply(X = dx1, MARGIN = 2, FUN = var)
##                       talla                        edad 
##                52.736666572                 1.105415925 
##                     peso_kg               circun_cuello 
##                71.893483362                 4.626391936 
##                         IMC              circun_cintura 
##                 9.200066964                48.301008547 
##                      cadera          ind_cintura_cadera 
##                52.005771300                 0.002931376 
##        ind_cintura_estatura          por_grasa_corporal 
##                 0.002114973                61.933110301 
##      masa_corporal_magra_kg      pliegue_cutaneo_BICEPS 
##                46.573967721                31.698054786 
##     pliegue_cutaneo_TRICEPS   pliegue_cutaneo_ESCAPULAR 
##                32.139942797                27.888277120 
## pliegue_cutaneo_SUPRAILIACO                      target 
##                35.298634475                 0.152337602

3. Análisis de correlación

#chart.Correlation(dfnum, histogram = F, pch = 19)

4. Estandariza automática - PCA

nutricion_PCA <- PCA(X = dx1, scale.unit = TRUE, ncp = 64, graph = FALSE)

nutricion_PCA$eig
##          eigenvalue percentage of variance cumulative percentage of variance
## comp 1  7.288723953            45.55452471                          45.55452
## comp 2  3.549299778            22.18312361                          67.73765
## comp 3  1.257515836             7.85947397                          75.59712
## comp 4  0.980274668             6.12671668                          81.72384
## comp 5  0.810795837             5.06747398                          86.79131
## comp 6  0.608692287             3.80432679                          90.59564
## comp 7  0.468409157             2.92755723                          93.52320
## comp 8  0.398958331             2.49348957                          96.01669
## comp 9  0.182719967             1.14199979                          97.15869
## comp 10 0.169072724             1.05670452                          98.21539
## comp 11 0.131442831             0.82151770                          99.03691
## comp 12 0.069906884             0.43691803                          99.47383
## comp 13 0.040475734             0.25297334                          99.72680
## comp 14 0.022735649             0.14209781                          99.86890
## comp 15 0.011698860             0.07311788                          99.94202
## comp 16 0.009277504             0.05798440                         100.00000

Es necesario escalar y centrar los datos para disminuir la variablidad

vamos a utilizar el método prcomp para centrar y escalar los datos

acp  <-   prcomp(dx1, center = TRUE, scale = TRUE)
print(acp)
## Standard deviations (1, .., p=16):
##  [1] 2.6997637 1.8839585 1.1213901 0.9900882 0.9004420 0.7801873 0.6844042
##  [8] 0.6316315 0.4274576 0.4111845 0.3625505 0.2643991 0.2011858 0.1507835
## [15] 0.1081613 0.0963198
## 
## Rotation (n x k) = (16 x 16):
##                                     PC1          PC2          PC3          PC4
## talla                        0.05679831 -0.406505560  0.379352389  0.129975978
## edad                        -0.05288211 -0.064974486  0.234323935 -0.940835202
## peso_kg                     -0.27285414 -0.306031198  0.221465441  0.112436303
## circun_cuello               -0.25402590 -0.288596488 -0.089269036  0.065908227
## IMC                         -0.34704451 -0.061623511 -0.002911211 -0.003676120
## circun_cintura              -0.31071130 -0.217544618 -0.162108447 -0.071943484
## cadera                      -0.31364600 -0.006368397  0.346348299  0.008371241
## ind_cintura_cadera          -0.05698886 -0.303400678 -0.658141819 -0.109495746
## ind_cintura_estatura        -0.32329518 -0.019816729 -0.336926998 -0.128618814
## por_grasa_corporal          -0.27305541  0.329769814  0.079244066  0.002638486
## masa_corporal_magra_kg      -0.06668002 -0.494651843  0.167780642  0.107567207
## pliegue_cutaneo_BICEPS      -0.20471425  0.229260515 -0.006794995  0.155200678
## pliegue_cutaneo_TRICEPS     -0.29340705  0.232164118  0.118014313  0.054532790
## pliegue_cutaneo_ESCAPULAR   -0.31699335  0.108992761 -0.038716210  0.008454089
## pliegue_cutaneo_SUPRAILIACO -0.30382750  0.185325717  0.032493432  0.012817172
## target                      -0.17910650 -0.062177082 -0.017165353  0.091013649
##                                     PC5          PC6          PC7          PC8
## talla                       -0.17420687  0.294986955 -0.425622791  0.105866498
## edad                         0.06889005  0.164084226 -0.007005586 -0.135641069
## peso_kg                     -0.08218329  0.067438822  0.035293857 -0.034008961
## circun_cuello                0.05715177 -0.165546931  0.249319977 -0.558002975
## IMC                          0.05748903 -0.134353433  0.306571573 -0.163159242
## circun_cintura              -0.11669756  0.039066743 -0.031164738  0.413913595
## cadera                      -0.02590848 -0.156376370  0.189771130  0.451782705
## ind_cintura_cadera          -0.15286771  0.225351003 -0.276895018  0.008564002
## ind_cintura_estatura        -0.01545121 -0.107032905  0.180732867  0.343822942
## por_grasa_corporal          -0.10000244  0.105908956 -0.108491242  0.049220960
## masa_corporal_magra_kg      -0.03053374  0.003746136  0.105510911 -0.101478463
## pliegue_cutaneo_BICEPS      -0.04551144  0.830952819  0.329258727 -0.116953984
## pliegue_cutaneo_TRICEPS     -0.09672882 -0.105556287 -0.239140302 -0.083376732
## pliegue_cutaneo_ESCAPULAR   -0.06786768 -0.128998212 -0.377664811 -0.261149007
## pliegue_cutaneo_SUPRAILIACO -0.14959767 -0.043889047 -0.347101942 -0.170031385
## target                       0.92969771  0.128114385 -0.251935743  0.084079198
##                                      PC9          PC10         PC11
## talla                       -0.002720536  0.0034810736  0.340598140
## edad                        -0.002900664  0.0301204285 -0.001532227
## peso_kg                     -0.006787985  0.0824058721 -0.451414460
## circun_cuello                0.138254293 -0.0004679393  0.541168343
## IMC                         -0.024158295  0.0681585954 -0.204514922
## circun_cintura               0.004902903 -0.0194384488  0.156916375
## cadera                      -0.031255159 -0.1588254015  0.257060687
## ind_cintura_cadera           0.031163352  0.1425299764 -0.063702780
## ind_cintura_estatura        -0.002485799 -0.0344876821  0.038954799
## por_grasa_corporal           0.035919730  0.0815422064 -0.226304490
## masa_corporal_magra_kg      -0.017121965  0.0275929051 -0.403563305
## pliegue_cutaneo_BICEPS      -0.077368725 -0.0657067329  0.097906471
## pliegue_cutaneo_TRICEPS     -0.020100600  0.7985939332  0.130033237
## pliegue_cutaneo_ESCAPULAR   -0.703426743 -0.3772736663 -0.004055509
## pliegue_cutaneo_SUPRAILIACO  0.687462298 -0.3852447773 -0.092008668
## target                       0.053619416  0.0175340440 -0.013932901
##                                     PC12        PC13         PC14         PC15
## talla                        0.317603747 -0.22625773  0.090128620  0.289579644
## edad                        -0.040041415  0.01256535 -0.008266884  0.005483026
## peso_kg                      0.068485868  0.25029750 -0.685524811  0.091780584
## circun_cuello                0.078377382  0.33914706  0.009318373  0.047772599
## IMC                          0.490980131 -0.63916648  0.104870734 -0.161420968
## circun_cintura              -0.030185645  0.07092579  0.011102418 -0.332109512
## cadera                      -0.106064687  0.07488146  0.010760153 -0.333827526
## ind_cintura_cadera           0.079242521  0.02681602  0.001853046 -0.275152481
## ind_cintura_estatura        -0.100446429 -0.08217467  0.024513590  0.759061531
## por_grasa_corporal           0.501395956  0.53557326  0.415512091  0.069686077
## masa_corporal_magra_kg      -0.431042048  0.04642859  0.579968860  0.022860236
## pliegue_cutaneo_BICEPS      -0.196744476 -0.08870109 -0.012694963 -0.010909050
## pliegue_cutaneo_TRICEPS     -0.294909275 -0.12748739 -0.012475844 -0.002766947
## pliegue_cutaneo_ESCAPULAR   -0.122452316 -0.03978015 -0.007045015  0.002639462
## pliegue_cutaneo_SUPRAILIACO -0.198037886 -0.17066088 -0.021279323 -0.011782557
## target                      -0.003373302  0.02266880  0.010134093 -0.008882648
##                                     PC16
## talla                       -0.030438940
## edad                        -0.002924820
## peso_kg                     -0.013542186
## circun_cuello                0.012638608
## IMC                          0.008503630
## circun_cintura               0.704167102
## cadera                      -0.543706498
## ind_cintura_cadera          -0.447894777
## ind_cintura_estatura        -0.078236915
## por_grasa_corporal          -0.009981486
## masa_corporal_magra_kg      -0.004278685
## pliegue_cutaneo_BICEPS      -0.003071471
## pliegue_cutaneo_TRICEPS     -0.004449737
## pliegue_cutaneo_ESCAPULAR    0.013950882
## pliegue_cutaneo_SUPRAILIACO  0.002768494
## target                      -0.010060137

Nos aseguramos que el nuevo dataframe no hay datos NaN

sum(is.na(dx1))    #total datos perdidos
## [1] 0

Los primeros 5 componentes explican el 86.79% de la varianza:

Graficamos el ACP con Plot

plot(acp, type="l")

fviz_screeplot(nutricion_PCA, addlabels = TRUE, ylim = c(0, 50))

Graficamos las observaciones sobre los dos primeros componentes principales. Dimensiones 1 y 2:

library(factoextra)
fviz_pca_ind(nutricion_PCA, geom.ind = "point", 
             col.ind = "#FC4E07", 
             axes = c(1, 2), 
             pointsize = 1.5) 

Dimensiones 1 y 3:

fviz_pca_ind(nutricion_PCA, geom.ind = "point", 
             col.ind = "#FC4E07", 
             axes = c(1, 3), 
             pointsize = 1.5) 

Dimensiones 1 y 4:

fviz_pca_ind(nutricion_PCA, geom.ind = "point", 
             col.ind = "#FC4E07", 
             axes = c(1, 4), 
             pointsize = 1.5) 

Dimensiones 1 y 5:

fviz_pca_ind(nutricion_PCA, geom.ind = "point", 
             col.ind = "#FC4E07", 
             axes = c(1, 5), 
             pointsize = 1.5) 

Vamos a identificar las variables con mayor contribución a nuestros componentes seleccionados

Dim1:

fviz_contrib(nutricion_PCA, choice = "var", axes = 1, top = 15)

Nota Explicativa: La línea roja nos indica la contribución media; toda contribución mayor a este puede considerarse importante para el componente.

Dim2:

fviz_contrib(nutricion_PCA, choice = "var", axes = 2, top = 15)

Dim3:

fviz_contrib(nutricion_PCA, choice = "var", axes = 3, top = 15)

Dim4:

fviz_contrib(nutricion_PCA, choice = "var", axes = 4, top = 15)

Observamos la función de los componentes Los nombres se asignarán con base en la composición de Componentes - variables

nutricion_PCA
## **Results for the Principal Component Analysis (PCA)**
## The analysis was performed on 652 individuals, described by 16 variables
## *The results are available in the following objects:
## 
##    name               description                          
## 1  "$eig"             "eigenvalues"                        
## 2  "$var"             "results for the variables"          
## 3  "$var$coord"       "coord. for the variables"           
## 4  "$var$cor"         "correlations variables - dimensions"
## 5  "$var$cos2"        "cos2 for the variables"             
## 6  "$var$contrib"     "contributions of the variables"     
## 7  "$ind"             "results for the individuals"        
## 8  "$ind$coord"       "coord. for the individuals"         
## 9  "$ind$cos2"        "cos2 for the individuals"           
## 10 "$ind$contrib"     "contributions of the individuals"   
## 11 "$call"            "summary statistics"                 
## 12 "$call$centre"     "mean of the variables"              
## 13 "$call$ecart.type" "standard error of the variables"    
## 14 "$call$row.w"      "weights for the individuals"        
## 15 "$call$col.w"      "weights for the variables"
summary(nutricion_PCA)
## 
## Call:
## PCA(X = dx1, scale.unit = TRUE, ncp = 64, graph = FALSE) 
## 
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6   Dim.7
## Variance               7.289   3.549   1.258   0.980   0.811   0.609   0.468
## % of var.             45.555  22.183   7.859   6.127   5.067   3.804   2.928
## Cumulative % of var.  45.555  67.738  75.597  81.724  86.791  90.596  93.523
##                        Dim.8   Dim.9  Dim.10  Dim.11  Dim.12  Dim.13  Dim.14
## Variance               0.399   0.183   0.169   0.131   0.070   0.040   0.023
## % of var.              2.493   1.142   1.057   0.822   0.437   0.253   0.142
## Cumulative % of var.  96.017  97.159  98.215  99.037  99.474  99.727  99.869
##                       Dim.15  Dim.16
## Variance               0.012   0.009
## % of var.              0.073   0.058
## Cumulative % of var.  99.942 100.000
## 
## Individuals (the 10 first)
##                                 Dist    Dim.1    ctr   cos2    Dim.2    ctr
## 1                           |  7.760 |  7.284  1.116  0.881 |  0.203  0.002
## 2                           |  3.037 |  1.434  0.043  0.223 |  0.221  0.002
## 3                           |  2.876 | -0.021  0.000  0.000 | -2.255  0.220
## 4                           |  2.206 |  0.502  0.005  0.052 | -0.854  0.032
## 5                           |  3.441 |  1.896  0.076  0.304 | -0.792  0.027
## 6                           |  4.717 |  4.044  0.344  0.735 |  0.731  0.023
## 7                           |  5.057 | -3.580  0.270  0.501 |  1.238  0.066
## 8                           |  2.920 | -2.534  0.135  0.753 |  0.017  0.000
## 9                           | 11.244 |  9.897  2.061  0.775 |  3.665  0.580
## 10                          |  4.770 | -4.176  0.367  0.766 |  1.322  0.076
##                               cos2    Dim.3    ctr   cos2  
## 1                            0.001 | -1.133  0.157  0.021 |
## 2                            0.005 |  1.545  0.291  0.259 |
## 3                            0.615 | -0.604  0.044  0.044 |
## 4                            0.150 | -0.470  0.027  0.045 |
## 5                            0.053 |  0.780  0.074  0.051 |
## 6                            0.024 |  1.404  0.240  0.089 |
## 7                            0.060 |  0.161  0.003  0.001 |
## 8                            0.000 | -0.030  0.000  0.000 |
## 9                            0.106 | -0.816  0.081  0.005 |
## 10                           0.077 |  0.983  0.118  0.043 |
## 
## Variables (the 10 first)
##                                Dim.1    ctr   cos2    Dim.2    ctr   cos2  
## talla                       | -0.153  0.323  0.024 |  0.766 16.525  0.587 |
## edad                        |  0.143  0.280  0.020 |  0.122  0.422  0.015 |
## peso_kg                     |  0.737  7.445  0.543 |  0.577  9.366  0.332 |
## circun_cuello               |  0.686  6.453  0.470 |  0.544  8.329  0.296 |
## IMC                         |  0.937 12.044  0.878 |  0.116  0.380  0.013 |
## circun_cintura              |  0.839  9.654  0.704 |  0.410  4.733  0.168 |
## cadera                      |  0.847  9.837  0.717 |  0.012  0.004  0.000 |
## ind_cintura_cadera          |  0.154  0.325  0.024 |  0.572  9.205  0.327 |
## ind_cintura_estatura        |  0.873 10.452  0.762 |  0.037  0.039  0.001 |
## por_grasa_corporal          |  0.737  7.456  0.543 | -0.621 10.875  0.386 |
##                              Dim.3    ctr   cos2  
## talla                        0.425 14.391  0.181 |
## edad                         0.263  5.491  0.069 |
## peso_kg                      0.248  4.905  0.062 |
## circun_cuello               -0.100  0.797  0.010 |
## IMC                         -0.003  0.001  0.000 |
## circun_cintura              -0.182  2.628  0.033 |
## cadera                       0.388 11.996  0.151 |
## ind_cintura_cadera          -0.738 43.315  0.545 |
## ind_cintura_estatura        -0.378 11.352  0.143 |
## por_grasa_corporal           0.089  0.628  0.008 |
summary(acp)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.6998 1.8840 1.12139 0.99009 0.90044 0.78019 0.68440
## Proportion of Variance 0.4556 0.2218 0.07859 0.06127 0.05067 0.03804 0.02928
## Cumulative Proportion  0.4556 0.6774 0.75597 0.81724 0.86791 0.90596 0.93523
##                            PC8     PC9    PC10    PC11    PC12    PC13    PC14
## Standard deviation     0.63163 0.42746 0.41118 0.36255 0.26440 0.20119 0.15078
## Proportion of Variance 0.02493 0.01142 0.01057 0.00822 0.00437 0.00253 0.00142
## Cumulative Proportion  0.96017 0.97159 0.98215 0.99037 0.99474 0.99727 0.99869
##                           PC15    PC16
## Standard deviation     0.10816 0.09632
## Proportion of Variance 0.00073 0.00058
## Cumulative Proportion  0.99942 1.00000

Graficamos la dispersión con Biplot

biplot(acp, scale=0)

pc1 <- apply(acp$rotation[, 1]*dx1, 1, sum)
pc2 <- apply(acp$rotation[, 2]*dx1, 1, sum)
pc3 <- apply(acp$rotation[, 3]*dx1, 1, sum)
pc4 <- apply(acp$rotation[, 4]*dx1, 1, sum)
summary(pc1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -201.61 -145.36 -121.84 -125.57 -106.41  -73.84

Creamos el nuevo dataframe con los valores del ACP

dnutricion_acp <- dx1
dnutricion_acp$pc1 <- pc1
dnutricion_acp$pc2 <- pc2
dnutricion_acp$pc3 <- pc3
dnutricion_acp$pc4 <- pc4
head(dnutricion_acp)
##   talla edad peso_kg circun_cuello      IMC circun_cintura cadera
## 1 155.7   16    71.2          35.7 29.57617           90.0   98.0
## 2 166.5   16    61.0          31.8 22.36471           80.9  100.5
## 3 151.3   16    49.1          30.5 21.62357           72.0   86.0
## 4 151.7   16    54.6          32.6 23.11748           74.4   88.4
## 5 160.3   16    58.0          30.1 22.26020           79.6   97.9
## 6 162.4   16    70.8          33.9 26.12445           86.5  106.1
##   ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1          0.9183673            0.5780347           36.44620
## 2          0.8049751            0.4858859           28.79071
## 3          0.8372093            0.4758757           29.86742
## 4          0.8416290            0.4904417           27.86764
## 5          0.8130746            0.4965689           30.27669
## 6          0.8152686            0.5326355           31.43973
##   masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1               45.25030                     13                      27
## 2               43.43766                      5                      19
## 3               34.43510                     13                      18
## 4               39.38427                      5                      19
## 5               40.43952                     10                      19
## 6               48.54067                     11                      25
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target       pc1
## 1                        32                          34      1 -136.9836
## 2                        15                          22      0 -129.2669
## 3                        18                          17      0 -119.8487
## 4                        15                          18      0 -116.4406
## 5                        20                          19      1 -138.5696
## 6                        18                          20      0 -164.8307
##          pc2        pc3         pc4
## 1  -54.06902  17.476924    5.037509
## 2   68.45323  55.261899 -196.940822
## 3 -125.94676  93.456256   43.697899
## 4  -30.08579 -46.294921   51.826244
## 5  -22.58760  66.041939   24.569935
## 6  -14.61240  -4.977216 -156.154659

Con base en la composición de cada Componente se le asignara el nombre.

nutricion_PCA$var$contrib
##                                  Dim.1        Dim.2        Dim.3        Dim.4
## talla                        0.3226048 16.524676993 1.439082e+01 1.689375e+00
## edad                         0.2796518  0.422168389 5.490771e+00 8.851709e+01
## peso_kg                      7.4449384  9.365509429 4.904694e+00 1.264192e+00
## circun_cuello                6.4529160  8.328793261 7.968961e-01 4.343894e-01
## IMC                         12.0439892  0.379745717 8.475148e-04 1.351386e-03
## circun_cintura               9.6541510  4.732566075 2.627915e+00 5.175865e-01
## cadera                       9.8373813  0.004055649 1.199571e+01 7.007767e-03
## ind_cintura_cadera           0.3247730  9.205197166 4.331507e+01 1.198932e+00
## ind_cintura_estatura        10.4519773  0.039270275 1.135198e+01 1.654280e+00
## por_grasa_corporal           7.4559257 10.874813034 6.279622e-01 6.961607e-04
## masa_corporal_magra_kg       0.4446225 24.468044585 2.815034e+00 1.157070e+00
## pliegue_cutaneo_BICEPS       4.1907924  5.256038385 4.617195e-03 2.408725e+00
## pliegue_cutaneo_TRICEPS      8.6087697  5.390017756 1.392738e+00 2.973825e-01
## pliegue_cutaneo_ESCAPULAR   10.0484781  1.187942193 1.498945e-01 7.147162e-03
## pliegue_cutaneo_SUPRAILIACO  9.2311149  3.434562141 1.055823e-01 1.642799e-02
## target                       3.2079140  0.386598954 2.946493e-02 8.283484e-01
##                                   Dim.5        Dim.6        Dim.7        Dim.8
## talla                        3.03480325  8.701730336 18.115476019  1.120771532
## edad                         0.47458391  2.692363330  0.004907823  1.839849966
## peso_kg                      0.67540940  0.454799478  0.124565633  0.115660941
## circun_cuello                0.32663244  2.740578632  6.216045097 31.136732036
## IMC                          0.33049880  1.805084491  9.398612938  2.662093827
## circun_cintura               1.36183196  0.152621042  0.097124088 17.132446394
## cadera                       0.06712492  2.445356895  3.601308196 20.410761289
## ind_cintura_cadera           2.33685368  5.078307444  7.667085101  0.007334212
## ind_cintura_estatura         0.02387400  1.145604266  3.266436939 11.821421561
## por_grasa_corporal           1.00004882  1.121670696  1.177034965  0.242270292
## masa_corporal_magra_kg       0.09323095  0.001403353  1.113255224  1.029787837
## pliegue_cutaneo_BICEPS       0.20712911 69.048258755 10.841130932  1.367823442
## pliegue_cutaneo_TRICEPS      0.93564637  1.114212980  5.718808420  0.695167947
## pliegue_cutaneo_ESCAPULAR    0.46060218  1.664053880 14.263070945  6.819880388
## pliegue_cutaneo_SUPRAILIACO  2.23794629  0.192624849 12.047975806  2.891067186
## target                      86.43378393  1.641329572  6.347161874  0.706931151
##                                    Dim.9       Dim.10       Dim.11       Dim.12
## talla                       7.401314e-04 1.211787e-03 11.600709275 10.087214023
## edad                        8.413849e-04 9.072402e-02  0.000234772  0.160331492
## peso_kg                     4.607674e-03 6.790728e-01 20.377501440  0.469031412
## circun_cuello               1.911425e+00 2.189672e-05 29.286317508  0.614301403
## IMC                         5.836232e-02 4.645594e-01  4.182635322 24.106148938
## circun_cintura              2.403845e-03 3.778533e-02  2.462274889  0.091117314
## cadera                      9.768850e-02 2.522551e+00  6.608019660  1.124971792
## ind_cintura_cadera          9.711545e-02 2.031479e+00  0.405804418  0.627937707
## ind_cintura_estatura        6.179196e-04 1.189400e-01  0.151747637  1.008948513
## por_grasa_corporal          1.290227e-01 6.649131e-01  5.121372204 25.139790453
## masa_corporal_magra_kg      2.931617e-02 7.613684e-02 16.286334105 18.579724716
## pliegue_cutaneo_BICEPS      5.985920e-01 4.317375e-01  0.958567703  3.870838887
## pliegue_cutaneo_TRICEPS     4.040341e-02 6.377523e+01  1.690864281  8.697148048
## pliegue_cutaneo_ESCAPULAR   4.948092e+01 1.423354e+01  0.001644716  1.499456974
## pliegue_cutaneo_SUPRAILIACO 4.726044e+01 1.484135e+01  0.846559496  3.921900409
## target                      2.875042e-01 3.074427e-02  0.019412574  0.001137917
##                                  Dim.13       Dim.14       Dim.15       Dim.16
## talla                        5.11925617 8.123168e-01 8.385637e+00 9.265290e-02
## edad                         0.01578879 6.834138e-03 3.006357e-03 8.554572e-04
## peso_kg                      6.26488379 4.699443e+01 8.423676e-01 1.833908e-02
## circun_cuello               11.50207252 8.683207e-03 2.282221e-01 1.597344e-02
## IMC                         40.85337902 1.099787e+00 2.605673e+00 7.231173e-03
## circun_cintura               0.50304674 1.232637e-02 1.102967e+01 4.958513e+01
## cadera                       0.56072334 1.157809e-02 1.114408e+01 2.956168e+01
## ind_cintura_cadera           0.07190990 3.433779e-04 7.570889e+00 2.006097e+01
## ind_cintura_estatura         0.67526766 6.009161e-02 5.761744e+01 6.121015e-01
## por_grasa_corporal          28.68387188 1.726503e+01 4.856149e-01 9.963007e-03
## masa_corporal_magra_kg       0.21556140 3.363639e+01 5.225904e-02 1.830715e-03
## pliegue_cutaneo_BICEPS       0.78678833 1.611621e-02 1.190074e-02 9.433931e-04
## pliegue_cutaneo_TRICEPS      1.62530351 1.556467e-02 7.655997e-04 1.980016e-03
## pliegue_cutaneo_ESCAPULAR    0.15824606 4.963224e-03 6.966762e-04 1.946271e-02
## pliegue_cutaneo_SUPRAILIACO  2.91251344 4.528096e-02 1.388286e-02 7.664556e-04
## target                       0.05138746 1.026998e-02 7.890144e-03 1.012064e-02

Guardamos los nuevos componentes. Solo los top 4 seleccionados.

nutricion_PCA$var$contrib
##                                  Dim.1        Dim.2        Dim.3        Dim.4
## talla                        0.3226048 16.524676993 1.439082e+01 1.689375e+00
## edad                         0.2796518  0.422168389 5.490771e+00 8.851709e+01
## peso_kg                      7.4449384  9.365509429 4.904694e+00 1.264192e+00
## circun_cuello                6.4529160  8.328793261 7.968961e-01 4.343894e-01
## IMC                         12.0439892  0.379745717 8.475148e-04 1.351386e-03
## circun_cintura               9.6541510  4.732566075 2.627915e+00 5.175865e-01
## cadera                       9.8373813  0.004055649 1.199571e+01 7.007767e-03
## ind_cintura_cadera           0.3247730  9.205197166 4.331507e+01 1.198932e+00
## ind_cintura_estatura        10.4519773  0.039270275 1.135198e+01 1.654280e+00
## por_grasa_corporal           7.4559257 10.874813034 6.279622e-01 6.961607e-04
## masa_corporal_magra_kg       0.4446225 24.468044585 2.815034e+00 1.157070e+00
## pliegue_cutaneo_BICEPS       4.1907924  5.256038385 4.617195e-03 2.408725e+00
## pliegue_cutaneo_TRICEPS      8.6087697  5.390017756 1.392738e+00 2.973825e-01
## pliegue_cutaneo_ESCAPULAR   10.0484781  1.187942193 1.498945e-01 7.147162e-03
## pliegue_cutaneo_SUPRAILIACO  9.2311149  3.434562141 1.055823e-01 1.642799e-02
## target                       3.2079140  0.386598954 2.946493e-02 8.283484e-01
##                                   Dim.5        Dim.6        Dim.7        Dim.8
## talla                        3.03480325  8.701730336 18.115476019  1.120771532
## edad                         0.47458391  2.692363330  0.004907823  1.839849966
## peso_kg                      0.67540940  0.454799478  0.124565633  0.115660941
## circun_cuello                0.32663244  2.740578632  6.216045097 31.136732036
## IMC                          0.33049880  1.805084491  9.398612938  2.662093827
## circun_cintura               1.36183196  0.152621042  0.097124088 17.132446394
## cadera                       0.06712492  2.445356895  3.601308196 20.410761289
## ind_cintura_cadera           2.33685368  5.078307444  7.667085101  0.007334212
## ind_cintura_estatura         0.02387400  1.145604266  3.266436939 11.821421561
## por_grasa_corporal           1.00004882  1.121670696  1.177034965  0.242270292
## masa_corporal_magra_kg       0.09323095  0.001403353  1.113255224  1.029787837
## pliegue_cutaneo_BICEPS       0.20712911 69.048258755 10.841130932  1.367823442
## pliegue_cutaneo_TRICEPS      0.93564637  1.114212980  5.718808420  0.695167947
## pliegue_cutaneo_ESCAPULAR    0.46060218  1.664053880 14.263070945  6.819880388
## pliegue_cutaneo_SUPRAILIACO  2.23794629  0.192624849 12.047975806  2.891067186
## target                      86.43378393  1.641329572  6.347161874  0.706931151
##                                    Dim.9       Dim.10       Dim.11       Dim.12
## talla                       7.401314e-04 1.211787e-03 11.600709275 10.087214023
## edad                        8.413849e-04 9.072402e-02  0.000234772  0.160331492
## peso_kg                     4.607674e-03 6.790728e-01 20.377501440  0.469031412
## circun_cuello               1.911425e+00 2.189672e-05 29.286317508  0.614301403
## IMC                         5.836232e-02 4.645594e-01  4.182635322 24.106148938
## circun_cintura              2.403845e-03 3.778533e-02  2.462274889  0.091117314
## cadera                      9.768850e-02 2.522551e+00  6.608019660  1.124971792
## ind_cintura_cadera          9.711545e-02 2.031479e+00  0.405804418  0.627937707
## ind_cintura_estatura        6.179196e-04 1.189400e-01  0.151747637  1.008948513
## por_grasa_corporal          1.290227e-01 6.649131e-01  5.121372204 25.139790453
## masa_corporal_magra_kg      2.931617e-02 7.613684e-02 16.286334105 18.579724716
## pliegue_cutaneo_BICEPS      5.985920e-01 4.317375e-01  0.958567703  3.870838887
## pliegue_cutaneo_TRICEPS     4.040341e-02 6.377523e+01  1.690864281  8.697148048
## pliegue_cutaneo_ESCAPULAR   4.948092e+01 1.423354e+01  0.001644716  1.499456974
## pliegue_cutaneo_SUPRAILIACO 4.726044e+01 1.484135e+01  0.846559496  3.921900409
## target                      2.875042e-01 3.074427e-02  0.019412574  0.001137917
##                                  Dim.13       Dim.14       Dim.15       Dim.16
## talla                        5.11925617 8.123168e-01 8.385637e+00 9.265290e-02
## edad                         0.01578879 6.834138e-03 3.006357e-03 8.554572e-04
## peso_kg                      6.26488379 4.699443e+01 8.423676e-01 1.833908e-02
## circun_cuello               11.50207252 8.683207e-03 2.282221e-01 1.597344e-02
## IMC                         40.85337902 1.099787e+00 2.605673e+00 7.231173e-03
## circun_cintura               0.50304674 1.232637e-02 1.102967e+01 4.958513e+01
## cadera                       0.56072334 1.157809e-02 1.114408e+01 2.956168e+01
## ind_cintura_cadera           0.07190990 3.433779e-04 7.570889e+00 2.006097e+01
## ind_cintura_estatura         0.67526766 6.009161e-02 5.761744e+01 6.121015e-01
## por_grasa_corporal          28.68387188 1.726503e+01 4.856149e-01 9.963007e-03
## masa_corporal_magra_kg       0.21556140 3.363639e+01 5.225904e-02 1.830715e-03
## pliegue_cutaneo_BICEPS       0.78678833 1.611621e-02 1.190074e-02 9.433931e-04
## pliegue_cutaneo_TRICEPS      1.62530351 1.556467e-02 7.655997e-04 1.980016e-03
## pliegue_cutaneo_ESCAPULAR    0.15824606 4.963224e-03 6.966762e-04 1.946271e-02
## pliegue_cutaneo_SUPRAILIACO  2.91251344 4.528096e-02 1.388286e-02 7.664556e-04
## target                       0.05138746 1.026998e-02 7.890144e-03 1.012064e-02
componentes <- nutricion_PCA$ind$coord [, 1:4]

save(componentes, file = "componentes.Rds")
save(dnutricion_acp, file = "dnutricion_acp.Rds")
head(dnutricion_acp)
##   talla edad peso_kg circun_cuello      IMC circun_cintura cadera
## 1 155.7   16    71.2          35.7 29.57617           90.0   98.0
## 2 166.5   16    61.0          31.8 22.36471           80.9  100.5
## 3 151.3   16    49.1          30.5 21.62357           72.0   86.0
## 4 151.7   16    54.6          32.6 23.11748           74.4   88.4
## 5 160.3   16    58.0          30.1 22.26020           79.6   97.9
## 6 162.4   16    70.8          33.9 26.12445           86.5  106.1
##   ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1          0.9183673            0.5780347           36.44620
## 2          0.8049751            0.4858859           28.79071
## 3          0.8372093            0.4758757           29.86742
## 4          0.8416290            0.4904417           27.86764
## 5          0.8130746            0.4965689           30.27669
## 6          0.8152686            0.5326355           31.43973
##   masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1               45.25030                     13                      27
## 2               43.43766                      5                      19
## 3               34.43510                     13                      18
## 4               39.38427                      5                      19
## 5               40.43952                     10                      19
## 6               48.54067                     11                      25
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target       pc1
## 1                        32                          34      1 -136.9836
## 2                        15                          22      0 -129.2669
## 3                        18                          17      0 -119.8487
## 4                        15                          18      0 -116.4406
## 5                        20                          19      1 -138.5696
## 6                        18                          20      0 -164.8307
##          pc2        pc3         pc4
## 1  -54.06902  17.476924    5.037509
## 2   68.45323  55.261899 -196.940822
## 3 -125.94676  93.456256   43.697899
## 4  -30.08579 -46.294921   51.826244
## 5  -22.58760  66.041939   24.569935
## 6  -14.61240  -4.977216 -156.154659

Fin!!

B. ANÁLISIS DE CLÚSTER

library("easypackages") # instalamos y cargamos los paquetes
paq <- c("tidyverse", "ggplot2", "ggcorrplot", "dplyr", "readxl",  "FactoMineR", 
         "corrplot", "GGally", "factoextra", "Hmisc", "PerformanceAnalytics", "car", "cluster",
         "NbClust", "tidyr", "readr")
packages(paq)
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ tibble  3.1.8     ✔ stringr 1.4.1
## ✔ tidyr   1.2.1     ✔ forcats 0.5.2
## ✔ purrr   0.3.5     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter()    masks stats::filter()
## ✖ xts::first()       masks dplyr::first()
## ✖ dplyr::lag()       masks stats::lag()
## ✖ xts::last()        masks dplyr::last()
## ✖ dplyr::recode()    masks car::recode()
## ✖ purrr::some()      masks car::some()
## ✖ Hmisc::src()       masks dplyr::src()
## ✖ Hmisc::summarize() masks dplyr::summarize()
## Loading required package: cluster
## 
## Loading required package: NbClust
## 
## All packages loaded successfully
set.seed(567)

1. Observamos la data

se toma el archivo dX1.RDS ya trabajado

dnutricion <- readRDS("dx1.rds")    #levantamos
head(dnutricion, 6)
##   talla edad peso_kg circun_cuello      IMC circun_cintura cadera
## 1 155.7   16    71.2          35.7 29.57617           90.0   98.0
## 2 166.5   16    61.0          31.8 22.36471           80.9  100.5
## 3 151.3   16    49.1          30.5 21.62357           72.0   86.0
## 4 151.7   16    54.6          32.6 23.11748           74.4   88.4
## 5 160.3   16    58.0          30.1 22.26020           79.6   97.9
## 6 162.4   16    70.8          33.9 26.12445           86.5  106.1
##   ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## 1          0.9183673            0.5780347           36.44620
## 2          0.8049751            0.4858859           28.79071
## 3          0.8372093            0.4758757           29.86742
## 4          0.8416290            0.4904417           27.86764
## 5          0.8130746            0.4965689           30.27669
## 6          0.8152686            0.5326355           31.43973
##   masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## 1               45.25030                     13                      27
## 2               43.43766                      5                      19
## 3               34.43510                     13                      18
## 4               39.38427                      5                      19
## 5               40.43952                     10                      19
## 6               48.54067                     11                      25
##   pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO target
## 1                        32                          34      1
## 2                        15                          22      0
## 3                        18                          17      0
## 4                        15                          18      0
## 5                        20                          19      1
## 6                        18                          20      0
View(dnutricion)
str(dnutricion) #data seleccionada para el an?lisis clUster
## 'data.frame':    652 obs. of  16 variables:
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                     : num  1 0 0 0 1 0 1 0 1 0 ...

##2. Viendo que las variables estan en diferentes escalas, vamos a normalizar las puntuaciones:

dnutricion <- scale(dnutricion)
View(dnutricion)
str(dnutricion)
##  num [1:652, 1:16] -0.42 1.067 -1.026 -0.971 0.213 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
##  - attr(*, "scaled:center")= Named num [1:16] 158.8 14.8 57 32.2 22.4 ...
##   ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
##  - attr(*, "scaled:scale")= Named num [1:16] 7.26 1.05 8.48 2.15 3.03 ...
##   ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...

3. Calcular las distancias con el método euclidean

Distancias <- get_dist(dnutricion, method = "euclidean") 

fviz_dist(Distancias, gradient = list(low = "blue", mid = "white", high = "red"))

Nota Explicativa: Como son bastantes casos, el gráfico no se aprecia mucho

4.Determinar el número de clústers.

Vamos a estimar el número de clusters idóneo: Elbow

fviz_nbclust(dnutricion, kmeans, method = "wss")

Vamos a estimar el número de clusters idoneo: Método silhouette

fviz_nbclust(dnutricion, kmeans, method = "silhouette")

Vamos a estimar el número de clusters idoneo: Método gap_stat

fviz_nbclust(dnutricion, kmeans, method = "gap_stat")

5. Realizaremos una clasificación Jerárquica para visualizar posible número de clústers

CJerarquico <- hcut(dnutricion, k = 5, stand = TRUE) #k = 2 a m?s
fviz_dend(CJerarquico, rect = TRUE, cex = 0.5,
          k_colors = c("red","#2E9FDF","green","black", "blue"))
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

6. Calculamos los k=5 clusters; podemos probar igual con 3 y 4 clusters.

kmeans5 <- kmeans(dnutricion, centers = 5, nstart = 25)
kmeans5
## K-means clustering with 5 clusters of sizes 168, 134, 159, 80, 111
## 
## Cluster means:
##           talla        edad       peso_kg circun_cuello         IMC
## 1 -0.5604446068  0.08311568  0.0008906537     0.1216919  0.42141257
## 2  0.4641404644 -0.15153885 -0.6488183365    -0.3590193 -0.98376085
## 3 -0.5415444566 -0.14622655 -0.7741914073    -1.0558198 -0.55352476
## 4 -0.0009028845  0.22465199  1.6122170426     1.4585600  1.82767351
## 5  1.0643033430  0.10469040  0.7289288073     0.7104044  0.02543421
##   circun_cintura      cadera ind_cintura_cadera ind_cintura_estatura
## 1      0.2426519  0.42967992         -0.1501702            0.4993421
## 2     -0.6892971 -1.06624098          0.3298816           -0.8583001
## 3     -0.8110643 -0.30999299         -0.8082744           -0.5390979
## 4      1.7792635  1.59734158          0.5255434            1.6957858
## 5      0.3443103 -0.07034573          0.6080777           -0.1695816
##   por_grasa_corporal masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 1          0.8329118             -0.5107833              0.5930933
## 2         -1.4172942              0.2504436             -0.8595099
## 3          0.3835601             -0.9303435              0.1453214
## 4          0.9883859              0.6904323              0.7653180
## 5         -0.8114297              1.3057854             -0.6197919
##   pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 1              0.67028610                 0.5481245                  0.69249563
## 2             -1.21738101                -1.0908120                 -1.18809083
## 3              0.07147844                -0.2848571                 -0.05754652
## 4              1.27306177                 1.5639078                  1.30493932
## 5             -0.56476597                -0.2318600                 -0.47189499
##        target
## 1  0.08486075
## 2 -0.28821010
## 3 -0.41495635
## 4  1.25000720
## 5 -0.08701773
## 
## Clustering vector:
##   [1] 4 1 3 1 1 4 2 2 4 2 2 2 2 2 1 4 2 2 5 4 1 1 1 3 1 2 4 2 2 2 2 1 2 1 4 2 2
##  [38] 2 1 4 4 2 2 1 3 1 2 3 3 5 3 3 4 1 3 2 1 2 2 1 5 1 4 5 1 5 3 3 1 2 2 2 4 5
##  [75] 4 3 3 5 5 1 1 4 4 3 1 1 3 3 2 3 5 3 4 1 1 3 5 3 1 1 4 3 4 5 1 1 1 3 1 2 1
## [112] 5 3 3 1 5 2 4 5 1 5 3 3 5 1 3 2 5 1 4 1 3 1 3 5 4 4 4 1 4 5 4 4 5 4 3 1 3
## [149] 5 4 1 1 5 1 5 1 5 5 5 3 3 2 1 5 3 2 2 3 1 1 1 2 2 1 1 3 2 2 1 2 3 5 3 3 3
## [186] 3 3 4 3 1 5 2 3 1 2 3 3 1 2 3 2 1 2 2 1 2 2 1 2 2 3 1 4 1 1 3 1 2 4 3 1 3
## [223] 2 2 2 1 3 2 3 2 1 3 1 3 3 1 3 2 1 2 1 3 3 4 2 1 1 2 2 1 1 2 4 4 1 2 2 2 5
## [260] 3 1 4 3 3 1 2 3 3 4 1 2 3 2 4 3 3 3 4 1 1 2 1 2 1 1 1 3 2 2 5 3 1 1 4 4 5
## [297] 1 2 2 2 2 5 1 2 2 4 1 1 5 3 3 4 5 5 3 5 4 5 3 1 1 5 3 1 1 5 5 5 1 2 3 2 3
## [334] 3 5 5 5 1 1 1 4 5 5 3 3 5 3 5 5 1 5 3 1 5 4 2 5 5 5 1 2 5 4 5 3 5 5 3 3 1
## [371] 1 5 5 1 3 3 5 1 1 3 5 5 1 1 5 3 4 1 5 3 5 5 1 2 2 2 3 2 1 2 1 4 4 5 4 3 2
## [408] 3 3 3 2 3 2 1 2 1 3 1 3 3 2 1 2 5 3 3 3 1 1 1 1 3 4 4 2 1 2 3 1 4 2 2 1 2
## [445] 1 2 3 1 2 2 2 1 2 3 2 1 3 3 1 1 2 3 5 2 3 2 3 2 2 3 2 2 1 3 1 5 1 3 4 1 2
## [482] 2 2 1 2 4 2 2 3 3 3 2 5 3 3 2 2 2 3 5 3 3 4 3 1 2 1 2 1 3 1 2 1 4 3 3 3 5
## [519] 2 3 4 1 4 1 3 4 1 4 3 5 4 5 1 5 5 2 5 3 3 1 3 3 5 1 5 1 1 4 2 3 5 5 2 4 5
## [556] 1 3 2 4 3 5 5 2 1 3 2 4 3 5 5 3 5 3 3 1 3 2 3 2 3 5 4 3 3 3 5 1 1 3 5 1 3
## [593] 3 1 5 4 3 5 5 4 5 1 5 5 5 1 3 1 5 1 3 5 2 3 4 1 4 1 4 5 1 1 3 3 3 4 5 5 4
## [630] 1 4 2 5 4 3 1 5 4 1 3 5 4 5 1 4 5 1 5 1 1 4 1
## 
## Within cluster sum of squares by cluster:
## [1] 1313.5942  663.9406 1001.9099 1005.5930  703.6762
##  (between_SS / total_SS =  55.0 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
head(dnutricion)
##           talla     edad    peso_kg circun_cuello         IMC circun_cintura
## [1,] -0.4200366 1.175776  1.6787048     1.6456906  2.35800308     2.21056509
## [2,]  1.0671567 1.175776  0.4757331    -0.1674998 -0.01953713     0.90119236
## [3,] -1.0259302 1.175776 -0.9277339    -0.7718965 -0.26388277    -0.37940295
## [4,] -0.9708490 1.175776 -0.2790726     0.2044367  0.22864352    -0.03407388
## [5,]  0.2133975 1.175776  0.1219179    -0.9578648 -0.05399327     0.71413911
## [6,]  0.5025740 1.175776  1.6315295     0.8088335  1.22000923     1.70696019
##          cadera ind_cintura_cadera ind_cintura_estatura por_grasa_corporal
## [1,]  1.1265659          1.6138783            2.3317044          1.6432643
## [2,]  1.4732343         -0.4804632            0.3279832          0.6704914
## [3,] -0.5374423          0.1148984            0.1103186          0.8073068
## [4,] -0.2046407          0.1965290            0.4270459          0.5531976
## [5,]  1.1126992         -0.3308674            0.5602798          0.8593121
## [6,]  2.2497715         -0.2903436            1.3445253          1.0070978
##      masa_corporal_magra_kg pliegue_cutaneo_BICEPS pliegue_cutaneo_TRICEPS
## [1,]             0.27923455              0.6787299               1.9984715
## [2,]             0.01362736             -0.7422034               0.5873401
## [3,]            -1.30552435              0.6787299               0.4109487
## [4,]            -0.58031924             -0.7422034               0.5873401
## [5,]            -0.42569245              0.1458799               0.5873401
## [6,]             0.76137454              0.3234966               1.6456886
##      pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO     target
## [1,]                 3.3344275                   3.2552814  2.0826904
## [2,]                 0.1153007                   1.2355097 -0.4794118
## [3,]                 0.6833819                   0.3939381 -0.4794118
## [4,]                 0.1153007                   0.5622524 -0.4794118
## [5,]                 1.0621027                   0.7305667  2.0826904
## [6,]                 0.6833819                   0.8988810 -0.4794118

estructura k-means

str(kmeans5)
## List of 9
##  $ cluster     : int [1:652] 4 1 3 1 1 4 2 2 4 2 ...
##  $ centers     : num [1:5, 1:16] -0.560445 0.46414 -0.541544 -0.000903 1.064303 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
##  $ totss       : num 10416
##  $ withinss    : num [1:5] 1314 664 1002 1006 704
##  $ tot.withinss: num 4689
##  $ betweenss   : num 5727
##  $ size        : int [1:5] 168 134 159 80 111
##  $ iter        : int 4
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Centroides de los clusters:

kmeans5$centers
##           talla        edad       peso_kg circun_cuello         IMC
## 1 -0.5604446068  0.08311568  0.0008906537     0.1216919  0.42141257
## 2  0.4641404644 -0.15153885 -0.6488183365    -0.3590193 -0.98376085
## 3 -0.5415444566 -0.14622655 -0.7741914073    -1.0558198 -0.55352476
## 4 -0.0009028845  0.22465199  1.6122170426     1.4585600  1.82767351
## 5  1.0643033430  0.10469040  0.7289288073     0.7104044  0.02543421
##   circun_cintura      cadera ind_cintura_cadera ind_cintura_estatura
## 1      0.2426519  0.42967992         -0.1501702            0.4993421
## 2     -0.6892971 -1.06624098          0.3298816           -0.8583001
## 3     -0.8110643 -0.30999299         -0.8082744           -0.5390979
## 4      1.7792635  1.59734158          0.5255434            1.6957858
## 5      0.3443103 -0.07034573          0.6080777           -0.1695816
##   por_grasa_corporal masa_corporal_magra_kg pliegue_cutaneo_BICEPS
## 1          0.8329118             -0.5107833              0.5930933
## 2         -1.4172942              0.2504436             -0.8595099
## 3          0.3835601             -0.9303435              0.1453214
## 4          0.9883859              0.6904323              0.7653180
## 5         -0.8114297              1.3057854             -0.6197919
##   pliegue_cutaneo_TRICEPS pliegue_cutaneo_ESCAPULAR pliegue_cutaneo_SUPRAILIACO
## 1              0.67028610                 0.5481245                  0.69249563
## 2             -1.21738101                -1.0908120                 -1.18809083
## 3              0.07147844                -0.2848571                 -0.05754652
## 4              1.27306177                 1.5639078                  1.30493932
## 5             -0.56476597                -0.2318600                 -0.47189499
##        target
## 1  0.08486075
## 2 -0.28821010
## 3 -0.41495635
## 4  1.25000720
## 5 -0.08701773

Tamaño de los clusters:

kmeans5$size
## [1] 168 134 159  80 111

Graficar los clusters

Gráfico de los cluster’s

fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster))

2do tipo de gráfico

fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster), ellipse.type = "euclid",repel = TRUE,star.plot = TRUE)
## Warning: ggrepel: 598 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

3er tipo de grafico

fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster),ellipse.type = "norm")

4to tipo de grafico

fviz_cluster(list(data = dnutricion, cluster = kmeans5$cluster), ellipse.type = "norm",palette = "Set2", ggtheme = theme_minimal())

Guardamos el clúster en la base de datos originales:

cluster <- data.frame(kmeans5$cluster)
str(cluster)
## 'data.frame':    652 obs. of  1 variable:
##  $ kmeans5.cluster: int  4 1 3 1 1 4 2 2 4 2 ...
str(dnutricion)
##  num [1:652, 1:16] -0.42 1.067 -1.026 -0.971 0.213 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
##  - attr(*, "scaled:center")= Named num [1:16] 158.8 14.8 57 32.2 22.4 ...
##   ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
##  - attr(*, "scaled:scale")= Named num [1:16] 7.26 1.05 8.48 2.15 3.03 ...
##   ..- attr(*, "names")= chr [1:16] "talla" "edad" "peso_kg" "circun_cuello" ...
data_nutricion_c <- dnutricion
data_nutricion_c$cluster <- as.factor(cluster$kmeans5.cluster)
## Warning in data_nutricion_c$cluster <- as.factor(cluster$kmeans5.cluster):
## Coercing LHS to a list
head(data_nutricion_c)
## [[1]]
## [1] -0.4200366
## 
## [[2]]
## [1] 1.067157
## 
## [[3]]
## [1] -1.02593
## 
## [[4]]
## [1] -0.970849
## 
## [[5]]
## [1] 0.2133975
## 
## [[6]]
## [1] 0.502574
saveRDS(data_nutricion_c, file="data_nutricion_c.rds")  # guardamos

Fin!!

————- Regresión Logística ————-

variable dependiente: Target 0: No tiene diabetes 1: Si tiene diabetes

Variable Independiente: IMC

  1. Cargamos los datos para el modelo
dnutricion <- dnutricion_acp
str(dnutricion)
## 'data.frame':    652 obs. of  20 variables:
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                     : num  1 0 0 0 1 0 1 0 1 0 ...
##  $ pc1                        : num  -137 -129 -120 -116 -139 ...
##  $ pc2                        : num  -54.1 68.5 -125.9 -30.1 -22.6 ...
##  $ pc3                        : num  17.5 55.3 93.5 -46.3 66 ...
##  $ pc4                        : num  5.04 -196.94 43.7 51.83 24.57 ...
#head(dnutricion)

Observamos a las variables independientes con la variable dependiente.

t1 <- table(dnutricion$IMC, dnutricion$target)
print(summary(t1))
## Number of cases in table: 652 
## Number of factors: 2 
## Test for independence of all factors:
##  Chisq = 652, df = 646, p-value = 0.4266
##  Chi-squared approximation may be incorrect
print("--------------------------------------------")
## [1] "--------------------------------------------"
print("Variable Independiente * Variable dependiente:")
## [1] "Variable Independiente * Variable dependiente:"
print(prop.table(t1, 1)*100)
##                   
##                      0   1
##   14.5378861653136 100   0
##   15.7611527668217 100   0
##   16.0724841794997 100   0
##   16.7431812044288 100   0
##   16.7531004171216 100   0
##   16.8601854864754 100   0
##   16.9663825268882 100   0
##   17.0169055221405 100   0
##   17.0768135208091 100   0
##   17.1070388885396 100   0
##   17.2606532873644 100   0
##   17.2873552184    100   0
##   17.2888161808447 100   0
##   17.292186450369    0 100
##   17.3186561009717   0 100
##   17.3252640322772   0 100
##   17.4687745654642   0 100
##   17.5335711667977   0 100
##   17.5438596491228 100   0
##   17.580843912473  100   0
##   17.5939655086626 100   0
##   17.6445578231293 100   0
##   17.6692965154504 100   0
##   17.7037917822698 100   0
##   17.7788587323887 100   0
##   17.8015494697302 100   0
##   17.8125572894749 100   0
##   17.8834720570749 100   0
##   17.9721620008169 100   0
##   18.1568985558093 100   0
##   18.2223421859749 100   0
##   18.2786209384421 100   0
##   18.2849795160305 100   0
##   18.3141489656264 100   0
##   18.3262885722559 100   0
##   18.412345796604  100   0
##   18.4331081069414 100   0
##   18.4365781710914 100   0
##   18.4514224369297 100   0
##   18.5167031554641 100   0
##   18.5210799444683 100   0
##   18.5740924188567 100   0
##   18.6077470526804 100   0
##   18.6085514538225 100   0
##   18.6167634185391 100   0
##   18.6307350671836 100   0
##   18.6312738137661 100   0
##   18.6334322300588 100   0
##   18.6562943239269 100   0
##   18.692033293698  100   0
##   18.7125142458011 100   0
##   18.7150617134417 100   0
##   18.730314624778  100   0
##   18.7574962349737 100   0
##   18.7701766315488 100   0
##   18.8054761546562 100   0
##   18.8205474609227 100   0
##   18.8648626719137 100   0
##   18.8717753190233 100   0
##   18.8753297249934 100   0
##   18.875536785548  100   0
##   18.9111173866933 100   0
##   18.9262642013812 100   0
##   18.932195489261  100   0
##   18.9783341552702 100   0
##   18.9790313467687 100   0
##   18.9807491994908 100   0
##   19.0311418685121 100   0
##   19.0521120627087 100   0
##   19.0666666666667 100   0
##   19.1014403965442 100   0
##   19.1190646730274 100   0
##   19.1570881226054 100   0
##   19.1680799959131 100   0
##   19.1765338855452 100   0
##   19.1887436170117 100   0
##   19.216312706265  100   0
##   19.2163782670153 100   0
##   19.2607340720222 100   0
##   19.2995784726988 100   0
##   19.3118569741946 100   0
##   19.3132154006243 100   0
##   19.3161786589135 100   0
##   19.3265887185232 100   0
##   19.3771626297578 100   0
##   19.3789560183037 100   0
##   19.379836884289  100   0
##   19.3806930785918 100   0
##   19.4215139528574 100   0
##   19.4247606869483 100   0
##   19.4385070306434 100   0
##   19.4423011064309 100   0
##   19.4650905629742 100   0
##   19.4789383978573 100   0
##   19.4951779001748 100   0
##   19.5092211553117 100   0
##   19.5480411437396 100   0
##   19.5612718784644 100   0
##   19.5685525533047 100   0
##   19.5694413504616 100   0
##   19.5716812826979 100   0
##   19.5719004792729 100   0
##   19.580169830561  100   0
##   19.5812212198193 100   0
##   19.585753225984  100   0
##   19.5918367346939 100   0
##   19.5977124124784 100   0
##   19.5992882901922 100   0
##   19.6383733815876 100   0
##   19.645129056844  100   0
##   19.6569832735651 100   0
##   19.6913476134255 100   0
##   19.7066251181474 100   0
##   19.7427984218978 100   0
##   19.7537141276846 100   0
##   19.7985288849693 100   0
##   19.8053417836125 100   0
##   19.8276705227236 100   0
##   19.8290362620309 100   0
##   19.8412067972726 100   0
##   19.8525432497581 100   0
##   19.8694198636704 100   0
##   19.8738418294686 100   0
##   19.8969959827575 100   0
##   19.9003093020351 100   0
##   19.9040664208749 100   0
##   19.9070341505171 100   0
##   19.9246700486889 100   0
##   19.9286139202855 100   0
##   19.9336235150588 100   0
##   19.9432125473229 100   0
##   19.944135536586  100   0
##   19.9516259070142 100   0
##   19.9529987162241 100   0
##   19.9534336741629 100   0
##   19.9580529513849 100   0
##   19.985912083107  100   0
##   19.9985587245609 100   0
##   20.0029744199881 100   0
##   20.02582339841   100   0
##   20.0284552423369 100   0
##   20.0287067344342 100   0
##   20.0326762506055 100   0
##   20.0402309616816 100   0
##   20.0522770751408 100   0
##   20.0710059171598 100   0
##   20.0755857898715 100   0
##   20.0923592149175 100   0
##   20.1174861189346 100   0
##   20.1347797501644 100   0
##   20.1406235271939 100   0
##   20.1529787610405 100   0
##   20.1846713935497 100   0
##   20.1977712343676 100   0
##   20.2121664992528 100   0
##   20.2291299471239 100   0
##   20.23950216667   100   0
##   20.248352082577  100   0
##   20.2589827316483 100   0
##   20.2733719396259 100   0
##   20.2741086028584 100   0
##   20.2751358377989 100   0
##   20.275478150936  100   0
##   20.279031751556  100   0
##   20.3160936029119 100   0
##   20.3209039908792 100   0
##   20.3733794467385 100   0
##   20.37862581039   100   0
##   20.4410774897554 100   0
##   20.4589614118462 100   0
##   20.4728337690893 100   0
##   20.4915521704026 100   0
##   20.5072199487802 100   0
##   20.5202516260718 100   0
##   20.5254203530068 100   0
##   20.5346601450498 100   0
##   20.5380282585114 100   0
##   20.5502653468328 100   0
##   20.554243066928  100   0
##   20.5630580323455 100   0
##   20.5917839701235 100   0
##   20.5967958646376 100   0
##   20.6117946660721   0 100
##   20.6161750708041   0 100
##   20.6239800096843   0 100
##   20.6378804653963   0 100
##   20.6508054400792   0 100
##   20.6666666666667 100   0
##   20.6669197016487 100   0
##   20.6729679490986 100   0
##   20.6854641331435 100   0
##   20.6974616347569 100   0
##   20.7227751234989 100   0
##   20.7327429817671 100   0
##   20.7677715592239 100   0
##   20.7697937152233 100   0
##   20.7882639264467 100   0
##   20.8055833332227 100   0
##   20.8086681798261 100   0
##   20.8189243199186 100   0
##   20.822913370556  100   0
##   20.8284023668639 100   0
##   20.8303091885615 100   0
##   20.8437791263129 100   0
##   20.8438148976006 100   0
##   20.8532434652851 100   0
##   20.8536783854167 100   0
##   20.8718157436106 100   0
##   20.8819995058512 100   0
##   20.8839115566346 100   0
##   20.911352640702  100   0
##   20.9129301230296 100   0
##   20.913693271607  100   0
##   20.9230588351773 100   0
##   20.9326168368524 100   0
##   20.9330052817916 100   0
##   20.9380151788758 100   0
##   20.9420118343195 100   0
##   20.9571711629325 100   0
##   20.963715331213  100   0
##   20.9858878321129 100   0
##   20.9900454934462 100   0
##   20.9936254423742 100   0
##   21.0036882476563 100   0
##   21.0040954426097 100   0
##   21.029380892836  100   0
##   21.0299530062981 100   0
##   21.0349651185729 100   0
##   21.0517082584097 100   0
##   21.0613943808533 100   0
##   21.0771952275208 100   0
##   21.0824503007587 100   0
##   21.0868426469678 100   0
##   21.0907841084847 100   0
##   21.1075853625931 100   0
##   21.1147114595215 100   0
##   21.1172179368667 100   0
##   21.1243316243263 100   0
##   21.1254780549991 100   0
##   21.136836628512  100   0
##   21.1427215019542 100   0
##   21.1671445437679 100   0
##   21.176601408939  100   0
##   21.2016929710059 100   0
##   21.2060567373439 100   0
##   21.2146316508877 100   0
##   21.2191358024691 100   0
##   21.2263856459689 100   0
##   21.2327408149661 100   0
##   21.2445267390322 100   0
##   21.2683250419606 100   0
##   21.3189452126752 100   0
##   21.3406795224977   0 100
##   21.3581143902124   0 100
##   21.3672516096452   0 100
##   21.3748209858742   0 100
##   21.3887885253836   0 100
##   21.4135984950282 100   0
##   21.4180501164853 100   0
##   21.4343195266272 100   0
##   21.44969920344   100   0
##   21.4550904534176 100   0
##   21.456894631321  100   0
##   21.4774388697352 100   0
##   21.4785807523437 100   0
##   21.4841792241639 100   0
##   21.484375        100   0
##   21.5177691688485 100   0
##   21.5248197296348 100   0
##   21.5268329554044 100   0
##   21.5355417052464 100   0
##   21.5510204081633 100   0
##   21.5601271469261 100   0
##   21.5719751309007 100   0
##   21.5748913685294 100   0
##   21.5848337433132 100   0
##   21.5903987884018 100   0
##   21.5945583327548 100   0
##   21.6162198136765 100   0
##   21.6235673294545 100   0
##   21.6860154115283 100   0
##   21.7129211393347 100   0
##   21.7148713953885   0 100
##   21.723970979304    0 100
##   21.7318208960595   0 100
##   21.7346084303612   0 100
##   21.7579013733176   0 100
##   21.7696544281935 100   0
##   21.7731488515839 100   0
##   21.7764801999231 100   0
##   21.7835466618593 100   0
##   21.7843566534871 100   0
##   21.8314372696683 100   0
##   21.8355773311215 100   0
##   21.8427197648977 100   0
##   21.8546990334759 100   0
##   21.8593798949815 100   0
##   21.866215090902  100   0
##   21.8716659045877 100   0
##   21.8989155377465 100   0
##   21.9158563538106 100   0
##   21.9238498280298 100   0
##   21.9250946076745 100   0
##   21.9252713667583 100   0
##   21.9494500618486 100   0
##   21.9543964348202 100   0
##   21.9694721696738 100   0
##   21.9718364534506 100   0
##   21.9872042388163 100   0
##   22.0119457481905 100   0
##   22.0228710921891 100   0
##   22.023870592661  100   0
##   22.0317256849864 100   0
##   22.0375108715583 100   0
##   22.0477906276475 100   0
##   22.0673881918998 100   0
##   22.07684544406   100   0
##   22.0855242607247 100   0
##   22.0940998232472 100   0
##   22.1140373519015 100   0
##   22.1268215799487 100   0
##   22.1325625736727 100   0
##   22.1647522481951 100   0
##   22.1718316956412 100   0
##   22.1770616602958 100   0
##   22.1854912764004 100   0
##   22.1897135304279 100   0
##   22.190577904355  100   0
##   22.1920091224069 100   0
##   22.1937514501599 100   0
##   22.194564741334  100   0
##   22.2190976616136 100   0
##   22.2212795798894 100   0
##   22.2305581626126 100   0
##   22.2548063320524 100   0
##   22.2575645368201 100   0
##   22.2583339051326 100   0
##   22.2595963593194 100   0
##   22.2601960064741   0 100
##   22.2706985149825   0 100
##   22.275137665531    0 100
##   22.2766218867199   0 100
##   22.2913233108161   0 100
##   22.2925248167689 100   0
##   22.2934831455401 100   0
##   22.2957065980907 100   0
##   22.3209175614111 100   0
##   22.3283179012346 100   0
##   22.3322753073273 100   0
##   22.3408890338723 100   0
##   22.341366205947  100   0
##   22.3498128203176 100   0
##   22.3647070493917 100   0
##   22.3648750174303 100   0
##   22.3907063232658 100   0
##   22.4087258220246 100   0
##   22.4153984041211 100   0
##   22.4285795711785 100   0
##   22.4438501657336 100   0
##   22.4535628431103 100   0
##   22.4712087637714 100   0
##   22.4755568177208 100   0
##   22.4838250691294 100   0
##   22.5             100   0
##   22.5180108057629 100   0
##   22.5215080401784 100   0
##   22.5563556448063 100   0
##   22.5834654926952 100   0
##   22.5927605136751 100   0
##   22.6082886464497 100   0
##   22.6283742774    100   0
##   22.6318993047242 100   0
##   22.6466801286156 100   0
##   22.6602292561933 100   0
##   22.6905074376733 100   0
##   22.6906001261158 100   0
##   22.6929281356612 100   0
##   22.7300972651932 100   0
##   22.7464185364954 100   0
##   22.7694383538539 100   0
##   22.7769679300292 100   0
##   22.7819490170698 100   0
##   22.7839689952409 100   0
##   22.7871920265506 100   0
##   22.798576520506  100   0
##   22.8060172799439 100   0
##   22.8286951625149 100   0
##   22.8407260510189 100   0
##   22.8457980685764 100   0
##   22.8498750054822   0 100
##   22.8550970862149   0 100
##   22.8618091873188   0 100
##   22.885918507721    0 100
##   22.88818359375     0 100
##   22.888700489452  100   0
##   22.8909939269563 100   0
##   22.9002094043816 100   0
##   22.9070216049383 100   0
##   22.9197044824983 100   0
##   22.9345046147003 100   0
##   22.9411343986117 100   0
##   22.9498077953597 100   0
##   22.9749975743947 100   0
##   22.9821658393087 100   0
##   22.9932733404267 100   0
##   22.9953199558123 100   0
##   23.0134269948287 100   0
##   23.0156287404672 100   0
##   23.0183925422021 100   0
##   23.0214545103485 100   0
##   23.028302410893  100   0
##   23.047418918305  100   0
##   23.0505361836968 100   0
##   23.0645977399224 100   0
##   23.0732254446403 100   0
##   23.0747024345642 100   0
##   23.0785255341079 100   0
##   23.0933596318212 100   0
##   23.1093509171269 100   0
##   23.1125163521053 100   0
##   23.1130365915864 100   0
##   23.1174789433226 100   0
##   23.1320730761906 100   0
##   23.141498292317  100   0
##   23.1439927244782 100   0
##   23.1571638556338   0 100
##   23.160802074989    0 100
##   23.1677433726888   0 100
##   23.1796422272613   0 100
##   23.1915959945362   0 100
##   23.2052832340594 100   0
##   23.2208200813926 100   0
##   23.2393838557821 100   0
##   23.2421962974641 100   0
##   23.2445945353274 100   0
##   23.2528799215846 100   0
##   23.2726678847391 100   0
##   23.294749029623  100   0
##   23.3009056030656 100   0
##   23.3289098472737 100   0
##   23.3294694279899 100   0
##   23.3752127564275 100   0
##   23.3798295577496   0 100
##   23.3951556104482   0 100
##   23.396506544677    0 100
##   23.4001856802497   0 100
##   23.4235574063058   0 100
##   23.4425671179193 100   0
##   23.4510761804257 100   0
##   23.4527839539558 100   0
##   23.4763481652949 100   0
##   23.494818546697  100   0
##   23.5024238227147 100   0
##   23.5124362225168 100   0
##   23.5144250774187 100   0
##   23.5215284628681 100   0
##   23.5259797394262 100   0
##   23.5283947355115 100   0
##   23.5431875957089 100   0
##   23.5453648915187 100   0
##   23.5457063711911 100   0
##   23.5500066058925 100   0
##   23.5822662906412 100   0
##   23.5846738927487 100   0
##   23.589207663201  100   0
##   23.6127413545076 100   0
##   23.6248021422821 100   0
##   23.6252734253673 100   0
##   23.6373675573577 100   0
##   23.6556374815089 100   0
##   23.6943024105186 100   0
##   23.7032396167802 100   0
##   23.7044569532215 100   0
##   23.7109375       100   0
##   23.7115237586536 100   0
##   23.7332384003797   0 100
##   23.7374284353622   0 100
##   23.7621568295676   0 100
##   23.7775583001512   0 100
##   23.7779366432792   0 100
##   23.8118159116899 100   0
##   23.8330046022354 100   0
##   23.8498002579228 100   0
##   23.870924976642  100   0
##   23.9048748354285 100   0
##   23.9118242092823 100   0
##   23.9219300776056 100   0
##   23.9318928453682 100   0
##   23.9843337828654 100   0
##   23.9850881280667 100   0
##   23.9884733093856 100   0
##   24               100   0
##   24.0273442016418 100   0
##   24.0417533923751 100   0
##   24.0417580166678 100   0
##   24.0435597134508   0 100
##   24.0555911094166   0 100
##   24.0691062604499   0 100
##   24.0955204425291   0 100
##   24.098697351735    0 100
##   24.1092507439455   0 100
##   24.1147252042942   0 100
##   24.1609040310339   0 100
##   24.2045980091718   0 100
##   24.276388958749    0 100
##   24.2764123602695 100   0
##   24.2792795928739 100   0
##   24.3019689241477 100   0
##   24.3068905121962 100   0
##   24.3194025548313 100   0
##   24.3247922437673 100   0
##   24.3301651111793 100   0
##   24.3868050580283 100   0
##   24.3890148652053 100   0
##   24.4125953969112 100   0
##   24.4351866688031 100   0
##   24.443509273148  100   0
##   24.4656004859606 100   0
##   24.4713549637792   0 100
##   24.4887530586374   0 100
##   24.4951038906843   0 100
##   24.5022221661069   0 100
##   24.5164743105359   0 100
##   24.5197096189975 100   0
##   24.5284808367155 100   0
##   24.563202187193  100   0
##   24.563901744393  100   0
##   24.5811968106526 100   0
##   24.5975115636989 100   0
##   24.598648073676  100   0
##   24.6272342825971 100   0
##   24.7093854556893 100   0
##   24.7357633378862   0 100
##   24.7678018575851   0 100
##   24.7872924064261   0 100
##   24.8286801610673   0 100
##   24.9041314228001   0 100
##   24.9242998571304 100   0
##   24.9619933520575 100   0
##   24.9680097375238 100   0
##   24.9926027641244 100   0
##   25.0545012459    100   0
##   25.1446017708462 100   0
##   25.1731197643912 100   0
##   25.2232528262211 100   0
##   25.2418752957728 100   0
##   25.2818106343451 100   0
##   25.283640970718  100   0
##   25.3169494267751 100   0
##   25.3321372121833 100   0
##   25.3415818291024 100   0
##   25.3902185223725 100   0
##   25.4193396691037 100   0
##   25.4766600920447 100   0
##   25.4952897570427 100   0
##   25.5084026407682 100   0
##   25.5893711736323 100   0
##   25.6102860140763 100   0
##   25.6160511367867 100   0
##   25.68            100   0
##   25.6866963848592 100   0
##   25.7553260378988   0 100
##   25.7879704613595   0 100
##   25.8213230026182   0 100
##   25.8515997931872   0 100
##   25.872412243389    0 100
##   25.887573964497  100   0
##   25.9034141818025 100   0
##   25.9447403415207 100   0
##   25.9471621425461 100   0
##   26.0161911532218 100   0
##   26.0415669364011   0 100
##   26.1048894457932   0 100
##   26.1244509694484 100   0
##   26.1357189552961 100   0
##   26.164140736913  100   0
##   26.2120918491575   0 100
##   26.2625462864123   0 100
##   26.2721714994893 100   0
##   26.3274266189917 100   0
##   26.4242536510418 100   0
##   26.4289592448212 100   0
##   26.4331584874122 100   0
##   26.4462809917355   0 100
##   26.451154653322    0 100
##   26.4610510054985   0 100
##   26.6132314724944   0 100
##   26.6294677855872   0 100
##   26.6532220784024 100   0
##   26.6983228484163 100   0
##   26.7022593143077   0 100
##   26.7435784553732   0 100
##   26.7533997859728   0 100
##   26.8242230649621   0 100
##   26.8268517689126   0 100
##   26.937225584431    0 100
##   27.005104599609    0 100
##   27.023922260635  100   0
##   27.0361285999712 100   0
##   27.0751124985436 100   0
##   27.0882228264803   0 100
##   27.0969482686587   0 100
##   27.120315581854    0 100
##   27.1736493240555   0 100
##   27.2016538605547 100   0
##   27.2322926489507 100   0
##   27.308315703406  100   0
##   27.4076572777871   0 100
##   27.4108947442534   0 100
##   27.4627077949177   0 100
##   27.4798626452487   0 100
##   27.5791682421486   0 100
##   27.6500811249324 100   0
##   27.6877107322908   0 100
##   27.7180825402395   0 100
##   27.8306786703601 100   0
##   28.091037079063  100   0
##   28.2673643717308   0 100
##   28.3443454945897   0 100
##   28.3763231226204   0 100
##   28.4089914068638   0 100
##   28.5087272732969   0 100
##   28.7295259628216   0 100
##   28.8283155106512   0 100
##   28.8740718444402   0 100
##   28.9941062457972   0 100
##   29.2373620768343   0 100
##   29.3935790725327   0 100
##   29.3939801128729 100   0
##   29.5042815072497   0 100
##   29.5761697746395   0 100
##   29.6485457063712   0 100
##   29.7126963278551   0 100
##   29.9230892485179   0 100
##   29.9986842682339 100   0
##   30.0102731941657 100   0
##   30.0492160666334 100   0
##   30.1368295132325 100   0
##   30.3715976331361 100   0
##   30.6784042740255   0 100
##   32.8929888747919   0 100
##   33.0970609077475   0 100
##   33.5825323365373   0 100
##   33.9193849284866   0 100
##   34.3079582748285   0 100
##   35.5212959958829   0 100
##   36.7086034651708   0 100
# Estas variables están relacionadas de manera significativa
  1. Crear un objeto llamado modelog que tendrá los cálculos del modelo lógistico
#modelog <- glm(dnutricion$target~ dnutricion$IMC, data = dnutricion, family="binomial")
modelog <- glm(dnutricion$target~ dnutricion$IMC, data = dnutricion, family="binomial")

Revisando la composición del modelo

names(modelog)
##  [1] "coefficients"      "residuals"         "fitted.values"    
##  [4] "effects"           "R"                 "rank"             
##  [7] "qr"                "family"            "linear.predictors"
## [10] "deviance"          "aic"               "null.deviance"    
## [13] "iter"              "weights"           "prior.weights"    
## [16] "df.residual"       "df.null"           "y"                
## [19] "converged"         "boundary"          "model"            
## [22] "call"              "formula"           "terms"            
## [25] "data"              "offset"            "control"          
## [28] "method"            "contrasts"         "xlevels"
  1. Definir fórmula del modelo de regresión logística log(p/1-p)= b0 + b1(x1)

Revisamos si la variable independinte es suficientemente explicativa para poder predecir a nuestra variable dependiente

Para esto se revisa los valores entregados del modelo

summary(modelog)
## 
## Call:
## glm(formula = dnutricion$target ~ dnutricion$IMC, family = "binomial", 
##     data = dnutricion)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8428  -0.5879  -0.4026  -0.2516   2.8347  
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -11.26529    1.04341 -10.797   <2e-16 ***
## dnutricion$IMC   0.42016    0.04347   9.665   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 628.55  on 651  degrees of freedom
## Residual deviance: 495.04  on 650  degrees of freedom
## AIC: 499.04
## 
## Number of Fisher Scoring iterations: 5

oefficients: Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.686638 0.513161 -7.184 6.76e-13 dnutricion$pc1 -0.017139 0.003779 -4.535 5.76e-06

Prueba de Hipótesis H0: variable x no aporta para predecir y Ha: variable x si aporta para predecir y

dado que el pvalor es menor que 0.05 Podemos concluir que nuestra variable independiente tiene la capacidad de predecir a la variable dependiente

  1. Revisamos los valores de los coeficientes Odd Ratio
exp(modelog$coefficients)
##    (Intercept) dnutricion$IMC 
##   1.280992e-05   1.522213e+00

Interpretación: Odds Ratio de la variable independiente es 1.52 por cada unidad que aumenta la variable IMC, el odds que se presente el evento de diabetes aumenta 1.5 veces, es decir aumenta un 50%

Otra forma para determinar la capacidad predictora de las variable independiente

# con pROC
# La variable independiente ingresa como numérico

library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following object is masked from 'package:colorspace':
## 
##     coords
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
ROC1 <- roc(dnutricion$IMC~as.numeric(dnutricion$target))
## Warning in roc.default(response, predictors[, 1], ...): 'response' has more
## than two levels. Consider setting 'levels' explicitly or using 'multiclass.roc'
## instead
## Setting levels: control = 14.5378861653136, case = 15.7611527668217
## Setting direction: controls < cases
print("Nivel predictibilidad de esta variable independiente sobre la variable dependiente es: ")
## [1] "Nivel predictibilidad de esta variable independiente sobre la variable dependiente es: "
print(ROC1)
## 
## Call:
## roc.formula(formula = dnutricion$IMC ~ as.numeric(dnutricion$target))
## 
## Data: as.numeric(dnutricion$target) in 1 controls (dnutricion$IMC 14.5378861653136) < 1 cases (dnutricion$IMC 15.7611527668217).
## Area under the curve: 0.5
print("Intervalo de confianza de la curva ROC")
## [1] "Intervalo de confianza de la curva ROC"
print(ci.auc(ROC1))
## 95% CI: NA-NA (DeLong)
plot(ROC1)

  1. observar las probabilidades que el modelo clasifique o no el evento Analizamos la variable fitted.values (valores ajustados)
modelog$fitted.values
##           1           2           3           4           5           6 
## 0.761619837 0.133724254 0.101576955 0.174778122 0.128718723 0.428319561 
##           7           8           9          10          11          12 
## 0.018188722 0.035882419 0.974901167 0.019957817 0.028779627 0.054935839 
##          13          14          15          16          17          18 
## 0.050479139 0.032203492 0.130401329 0.661765834 0.032967201 0.029735707 
##          19          20          21          22          23          24 
## 0.192336765 0.984607759 0.195923661 0.417219636 0.198835236 0.076161298 
##          25          26          27          28          29          30 
## 0.409938717 0.032797769 0.311530860 0.061273366 0.035207817 0.067183032 
##          31          32          33          34          35          36 
## 0.054679528 0.259776838 0.064818413 0.057447821 0.544076713 0.100101360 
##          37          38          39          40          41          42 
## 0.091841188 0.079602879 0.213153795 0.700012760 0.532383815 0.018238370 
##          43          44          45          46          47          48 
## 0.029788810 0.269240311 0.045740711 0.267376844 0.107317075 0.060290963 
##          49          50          51          52          53          54 
## 0.090477716 0.148773238 0.067287848 0.099615726 0.394105333 0.192248605 
##          55          56          57          58          59          60 
## 0.088742651 0.016667092 0.314937772 0.120323237 0.054033850 0.276284596 
##          61          62          63          64          65          66 
## 0.077385702 0.125239351 0.747413079 0.070320652 0.162388633 0.076462908 
##          67          68          69          70          71          72 
## 0.153417903 0.154678342 0.280012669 0.065653435 0.027376126 0.017966173 
##          73          74          75          76          77          78 
## 0.816945992 0.075614056 0.567971103 0.077690096 0.135881322 0.073727704 
##          79          80          81          82          83          84 
## 0.218465056 0.207678580 0.365154265 0.400506984 0.256318557 0.086649560 
##          85          86          87          88          89          90 
## 0.390834931 0.122823229 0.097591487 0.056645640 0.028496399 0.020264040 
##          91          92          93          94          95          96 
## 0.061389724 0.131962991 0.432407732 0.237979808 0.192577016 0.145218880 
##          97          98          99         100         101         102 
## 0.121987096 0.050031354 0.185782286 0.213239593 0.795814675 0.045721432 
##         103         104         105         106         107         108 
## 0.562286708 0.213696766 0.167378444 0.155478308 0.169439639 0.045823897 
##         109         110         111         112         113         114 
## 0.331721566 0.034355586 0.419814343 0.130192628 0.042899423 0.050506651 
##         115         116         117         118         119         120 
## 0.125473681 0.176390702 0.067520668 0.523568626 0.111266196 0.105131805 
##         121         122         123         124         125         126 
## 0.136210848 0.043193539 0.060383771 0.105914544 0.277022095 0.095296650 
##         127         128         129         130         131         132 
## 0.031149633 0.223664222 0.163965423 0.704034368 0.163114767 0.039058536 
##         133         134         135         136         137         138 
## 0.130295428 0.077408598 0.117987146 0.513194145 0.463245653 0.204753124 
##         139         140         141         142         143         144 
## 0.339087668 0.437359104 0.334383158 0.691224613 0.792342985 0.220905230 
##         145         146         147         148         149         150 
## 0.488518077 0.074226209 0.272240715 0.084007351 0.105803684 0.587176613 
##         151         152         153         154         155         156 
## 0.201092115 0.363341635 0.238117468 0.196036727 0.168691567 0.225209194 
##         157         158         159         160         161         162 
## 0.181129358 0.282868501 0.256316683 0.037178245 0.114771781 0.014397138 
##         163         164         165         166         167         168 
## 0.376426291 0.092161899 0.040209792 0.032437406 0.044438258 0.085364349 
##         169         170         171         172         173         174 
## 0.080969980 0.200017055 0.218437916 0.040844418 0.030972955 0.317719141 
##         175         176         177         178         179         180 
## 0.182615692 0.027512267 0.041291343 0.044188375 0.144734768 0.009536885 
##         181         182         183         184         185         186 
## 0.158920008 0.202240063 0.046800365 0.022189374 0.141542019 0.059205063 
##         187         188         189         190         191         192 
## 0.053034721 0.958897400 0.052468782 0.159149107 0.109999600 0.031183852 
##         193         194         195         196         197         198 
## 0.066058416 0.125657609 0.052101607 0.150391537 0.073141853 0.222441254 
##         199         200         201         202         203         204 
## 0.034405166 0.015049736 0.148053735 0.228970619 0.022289947 0.141363568 
##         205         206         207         208         209         210 
## 0.161999690 0.019350007 0.069879303 0.174286105 0.052551226 0.028738902 
##         211         212         213         214         215         216 
## 0.095101533 0.315483421 0.551988401 0.129494722 0.171596605 0.101295570 
##         217         218         219         220         221         222 
## 0.155366899 0.021315458 0.787068410 0.051962239 0.138108558 0.046044106 
##         223         224         225         226         227         228 
## 0.039495630 0.036647619 0.014338118 0.107592135 0.114983103 0.043901084 
##         229         230         231         232         233         234 
## 0.054622397 0.041118541 0.492856758 0.105492044 0.273691437 0.070313702 
##         235         236         237         238         239         240 
## 0.045566070 0.194108547 0.081652792 0.110982521 0.242345815 0.031475369 
##         241         242         243         244         245         246 
## 0.161186193 0.081958486 0.157961842 0.835442457 0.057167373 0.202263213 
##         247         248         249         250         251         252 
## 0.258370773 0.035872286 0.054128761 0.228221856 0.158635365 0.041047007 
##         253         254         255         256         257         258 
## 0.579935999 0.793143011 0.106844910 0.072150350 0.068418668 0.074887744 
##         259         260         261         262         263         264 
## 0.113683467 0.132153575 0.271761945 0.747444889 0.184382960 0.136863780 
##         265         266         267         268         269         270 
## 0.294799117 0.016057643 0.093804187 0.122563584 0.410184875 0.157961842 
##         271         272         273         274         275         276 
## 0.017991174 0.070486971 0.060299112 0.767096900 0.066773288 0.166729049 
##         277         278         279         280         281         282 
## 0.051893701 0.276012872 0.234813046 0.168854478 0.017955346 0.213738159 
##         283         284         285         286         287         288 
## 0.074943268 0.212524670 0.177419096 0.159821275 0.058475419 0.094546884 
##         289         290         291         292         293         294 
## 0.057035176 0.126896025 0.147272106 0.260647339 0.159442948 0.302979824 
##         295         296         297         298         299         300 
## 0.529025477 0.143330461 0.186173899 0.124287827 0.034259360 0.050752443 
##         301         302         303         304         305         306 
## 0.056084117 0.111492871 0.605440549 0.081126827 0.030439346 0.540881617 
##         307         308         309         310         311         312 
## 0.488104812 0.182465330 0.115730889 0.045376238 0.062802144 0.402608402 
##         313         314         315         316         317         318 
## 0.134994783 0.087937358 0.066861527 0.200629033 0.655659671 0.082626610 
##         319         320         321         322         323         324 
## 0.237980160 0.501327280 0.109829418 0.119903282 0.049010371 0.344623225 
##         325         326         327         328         329         330 
## 0.229710468 0.133000971 0.076519659 0.183135900 0.250609245 0.034408056 
##         331         332         333         334         335         336 
## 0.026981445 0.045136041 0.117466730 0.055712191 0.054771273 0.095362025 
##         337         338         339         340         341         342 
## 0.146030630 0.349414663 0.105054739 0.256548266 0.927921550 0.177196112 
##         343         344         345         346         347         348 
## 0.080165187 0.062672526 0.045570076 0.116393323 0.120709741 0.070831750 
##         349         350         351         352         353         354 
## 0.404141530 0.128464967 0.054684990 0.075626830 0.449317824 0.100312188 
##         355         356         357         358         359         360 
## 0.771877745 0.045935789 0.282965378 0.131607224 0.098828814 0.207711165 
##         361         362         363         364         365         366 
## 0.045508934 0.150396513 0.405745267 0.096355604 0.083430655 0.187999140 
##         367         368         369         370         371         372 
## 0.177845134 0.038733971 0.112632123 0.099170117 0.279953415 0.113743663 
##         373         374         375         376         377         378 
## 0.350317291 0.520316114 0.043259469 0.039496675 0.209818530 0.170758380 
##         379         380         381         382         383         384 
## 0.274222193 0.033648629 0.147086203 0.121092698 0.187963250 0.156698591 
##         385         386         387         388         389         390 
## 0.200150801 0.077338393 0.479176514 0.258767208 0.217335154 0.117943450 
##         391         392         393         394         395         396 
## 0.347965420 0.172200969 0.215572999 0.048797048 0.030869564 0.053072880 
##         397         398         399         400         401         402 
## 0.078262629 0.058173121 0.161314911 0.052040059 0.204917890 0.529938821 
##         403         404         405         406         407         408 
## 0.397456500 0.176238493 0.631249293 0.023799183 0.020373786 0.079730963 
##         409         410         411         412         413         414 
## 0.103996613 0.097927387 0.059907586 0.083740672 0.051417130 0.179315253 
##         415         416         417         418         419         420 
## 0.042955469 0.083659902 0.107877547 0.260212533 0.099725680 0.096362766 
##         421         422         423         424         425         426 
## 0.080152572 0.180163124 0.035907397 0.138993474 0.042186155 0.113736176 
##         427         428         429         430         431         432 
## 0.048096403 0.591003762 0.078141578 0.107457814 0.199344764 0.150521541 
##         433         434         435         436         437         438 
## 0.671081112 0.537958278 0.015725668 0.169035110 0.028954474 0.161344296 
##         439         440         441         442         443         444 
## 0.240070231 0.501603400 0.025670746 0.020802405 0.152529344 0.019873439 
##         445         446         447         448         449         450 
## 0.236883642 0.069527156 0.118584874 0.200929150 0.027051674 0.066531774 
##         451         452         453         454         455         456 
## 0.053762888 0.383991638 0.034908220 0.087085460 0.085364349 0.269928874 
##         457         458         459         460         461         462 
## 0.092921816 0.046073198 0.323383432 0.285408686 0.082766606 0.084566544 
##         463         464         465         466         467         468 
## 0.087540993 0.026367542 0.124611939 0.042200693 0.036959959 0.092428342 
##         469         470         471         472         473         474 
## 0.086504564 0.085675096 0.035123262 0.074315325 0.164347633 0.043657512 
##         475         476         477         478         479         480 
## 0.383326324 0.156285905 0.233943974 0.087327937 0.933450134 0.309716255 
##         481         482         483         484         485         486 
## 0.037974404 0.098251101 0.021983458 0.206845964 0.059656525 0.532383815 
##         487         488         489         490         491         492 
## 0.075336575 0.077978343 0.155656204 0.079841399 0.051326587 0.042171203 
##         493         494         495         496         497         498 
## 0.161474728 0.053063697 0.118331043 0.058809310 0.069150266 0.083970292 
##         499         500         501         502         503         504 
## 0.078723340 0.168561876 0.107910304 0.030859454 0.945055191 0.128631004 
##         505         506         507         508         509         510 
## 0.195361044 0.010855214 0.191250607 0.038866443 0.182289122 0.022948619 
##         511         512         513         514         515         516 
## 0.174509076 0.060248987 0.178577317 0.493888222 0.096150982 0.049895478 
##         517         518         519         520         521         522 
## 0.132569209 0.065172628 0.038562377 0.033443328 0.376995047 0.128690470 
##         523         524         525         526         527         528 
## 0.714434131 0.340843399 0.068284570 0.658686715 0.281480032 0.562621470 
##         529         530         531         532         533         534 
## 0.047150420 0.133732430 0.483371261 0.265259537 0.292500282 0.097852689 
##         535         536         537         538         539         540 
## 0.052876885 0.053170505 0.082459399 0.139629074 0.074728122 0.227707966 
##         541         542         543         544         545         546 
## 0.052656124 0.110788621 0.091232017 0.233632413 0.215275445 0.459894621 
##         547         548         549         550         551         552 
## 0.140447514 0.429479230 0.005726091 0.155092453 0.130249807 0.167498319 
##         553         554         555         556         557         558 
## 0.066397026 0.480879274 0.127328586 0.443580401 0.059448272 0.078922991 
##         559         560         561         562         563         564 
## 0.801731311 0.139212251 0.060266514 0.071164235 0.050982409 0.068939476 
##         565         566         567         568         569         570 
## 0.068821434 0.052857466 0.756092722 0.084375323 0.125433835 0.125620070 
##         571         572         573         574         575         576 
## 0.031936370 0.129214430 0.041069479 0.125539682 0.354982403 0.100470027 
##         577         578         579         580         581         582 
## 0.032236867 0.071870478 0.016460226 0.037704802 0.086935122 0.461702932 
##         583         584         585         586         587         588 
## 0.021015192 0.096109294 0.055199207 0.046927153 0.265440535 0.170572997 
##         589         590         591         592         593         594 
## 0.073199472 0.075337622 0.205228428 0.031156465 0.129424441 0.233689168 
##         595         596         597         598         599         600 
## 0.239035778 0.951958114 0.077990079 0.174477590 0.164848739 0.299320048 
##         601         602         603         604         605         606 
## 0.113345497 0.247177217 0.297605365 0.459403558 0.128594775 0.190950747 
##         607         608         609         610         611         612 
## 0.064364412 0.119037071 0.374365813 0.115629267 0.017758584 0.110293741 
##         613         614         615         616         617         618 
## 0.124851843 0.093963303 0.460332907 0.166311031 0.426308221 0.243160921 
##         619         620         621         622         623         624 
## 0.366432422 0.172430069 0.344796940 0.124851843 0.082892415 0.126794488 
##         625         626         627         628         629         630 
## 0.074612316 0.648320880 0.202092507 0.197601862 0.734821743 0.137623503 
##         631         632         633         634         635         636 
## 0.527652777 0.055611043 0.202554903 0.462211904 0.047803369 0.132592266 
##         637         638         639         640         641         642 
## 0.357788952 0.594084750 0.243584481 0.045525158 0.242100806 0.442582459 
##         643         644         645         646         647         648 
## 0.042140777 0.173321289 0.569738895 0.208548661 0.274817847 0.080952094 
##         649         650         651         652 
## 0.175664302 0.154678342 0.522289154 0.172112525
  1. Se define el punto de corte Para esto creamos una nueva variable que agregamos a la data original
str(dnutricion)
## 'data.frame':    652 obs. of  20 variables:
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                     : num  1 0 0 0 1 0 1 0 1 0 ...
##  $ pc1                        : num  -137 -129 -120 -116 -139 ...
##  $ pc2                        : num  -54.1 68.5 -125.9 -30.1 -22.6 ...
##  $ pc3                        : num  17.5 55.3 93.5 -46.3 66 ...
##  $ pc4                        : num  5.04 -196.94 43.7 51.83 24.57 ...
#dx1$predicho<- as.numeric(modelog$fitted.values>=0.5)

dx2<-dnutricion
dx2$target<-as.factor(dx2$target)
levels(dx2$target) = c('NO', 'SI')
str(dx2)
## 'data.frame':    652 obs. of  20 variables:
##  $ talla                      : num  156 166 151 152 160 ...
##  $ edad                       : num  16 16 16 16 16 16 16 16 16 16 ...
##  $ peso_kg                    : num  71.2 61 49.1 54.6 58 70.8 47.4 49.3 91 50.4 ...
##  $ circun_cuello              : num  35.7 31.8 30.5 32.6 30.1 33.9 30.5 31.2 37.5 30.8 ...
##  $ IMC                        : num  29.6 22.4 21.6 23.1 22.3 ...
##  $ circun_cintura             : num  90 80.9 72 74.4 79.6 ...
##  $ cadera                     : num  98 100.5 86 88.4 97.9 ...
##  $ ind_cintura_cadera         : num  0.918 0.805 0.837 0.842 0.813 ...
##  $ ind_cintura_estatura       : num  0.578 0.486 0.476 0.49 0.497 ...
##  $ por_grasa_corporal         : num  36.4 28.8 29.9 27.9 30.3 ...
##  $ masa_corporal_magra_kg     : num  45.3 43.4 34.4 39.4 40.4 ...
##  $ pliegue_cutaneo_BICEPS     : num  13 5 13 5 10 11 3.5 5.5 25 3 ...
##  $ pliegue_cutaneo_TRICEPS    : num  27 19 18 19 19 25 7 12 21 7 ...
##  $ pliegue_cutaneo_ESCAPULAR  : num  32 15 18 15 20 18 6 10.5 25 8.5 ...
##  $ pliegue_cutaneo_SUPRAILIACO: num  34 22 17 18 19 20 6 11.5 15 9 ...
##  $ target                     : Factor w/ 2 levels "NO","SI": 2 1 1 1 2 1 2 1 2 1 ...
##  $ pc1                        : num  -137 -129 -120 -116 -139 ...
##  $ pc2                        : num  -54.1 68.5 -125.9 -30.1 -22.6 ...
##  $ pc3                        : num  17.5 55.3 93.5 -46.3 66 ...
##  $ pc4                        : num  5.04 -196.94 43.7 51.83 24.57 ...
valores_predichos<- as.numeric(modelog$fitted.values>=0.5)
table(valores_predichos)
## valores_predichos
##   0   1 
## 597  55
valores_predichos<- factor(valores_predichos, labels = levels(dx2$target))
table(valores_predichos)
## valores_predichos
##  NO  SI 
## 597  55
  1. Evaluamos el modelo para determinar si está clasificando bien los valores predichos

Usaremos una matriz de confusión o de contigencia

La librería caret nos proporciona también la precisión, la sensibilidad y la especificidad del modelo de regresión logística

library(caret)
## 
## Attaching package: 'caret'
## The following object is masked from 'package:purrr':
## 
##     lift
## The following object is masked from 'package:mlr':
## 
##     train
## The following object is masked from 'package:survival':
## 
##     cluster
caret::confusionMatrix(valores_predichos, dx2$target, positive='SI')
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  NO  SI
##         NO 515  82
##         SI  15  40
##                                           
##                Accuracy : 0.8512          
##                  95% CI : (0.8216, 0.8777)
##     No Information Rate : 0.8129          
##     P-Value [Acc > NIR] : 0.005881        
##                                           
##                   Kappa : 0.3799          
##                                           
##  Mcnemar's Test P-Value : 2.066e-11       
##                                           
##             Sensitivity : 0.32787         
##             Specificity : 0.97170         
##          Pos Pred Value : 0.72727         
##          Neg Pred Value : 0.86265         
##              Prevalence : 0.18712         
##          Detection Rate : 0.06135         
##    Detection Prevalence : 0.08436         
##       Balanced Accuracy : 0.64978         
##                                           
##        'Positive' Class : SI              
## 

Interpretación: El modelo tiene un 85% de precisión al predecir diabetes Tiene una sensibilidad : de 32% (Casos predichos positivos que son positivos) Tiene una Especificidad : de 97% (Casos predichos negativos que son negativos)